home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / tabs.zip / RBBSSUB2.BAS < prev    next >
BASIC Source File  |  1990-05-08  |  140KB  |  4,060 lines
  1. ' $linesize:132
  2. ' $title: 'RBBSSUB2.BAS CPC17.3, Copyright 1986 - 90 by D. Thomas Mack'
  3. '  Copyright 1990 by D. Thomas Mack, all rights reserved.
  4. '  Name ...............: RBBSSUB2.BAS
  5. '  First Released .....: February 11, 1990
  6. '  Subsequent Releases.:
  7. '  Copyright ..........: 1986 - 1990
  8. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  9. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  10. '     require error trapping are incorporated within RBBSSUB 2-5 as
  11. '     separately callable subroutines in order to free up as much
  12. '     code as possible within the 64WasK code segment used by RBBS-PC.BAS.
  13. '  Parameters..........: Most parameters are passed via a COMMON statement.
  14. '
  15. ' Subroutine  Line               Function of Subroutine
  16. '   Name     Number
  17. '  Macro          1320  Check/execute macro
  18. '  AnswerIt        200  Answer the telephone when it rings
  19. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  20. '  BadChar         455  Check user name for invalid characters
  21. '  BadName       20235  Check for system crash attempt with bad file name
  22. '  Baud450        5507  Allow 300 baud callers to bump up to 450 baud
  23. '  CheckRatio    20096  Test upload/download ratio
  24. '  CheckMacro     1242  Checks for macro and processes
  25. '  CopyRight        97  Display RBBS-PC's copyright notice
  26. '  DEFALTU        9600  Write out the user's defaults
  27. '  DenyAccess     1386  Downgrade security so access denied
  28. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  29. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  30. '  EditALine      2618  Edits a single line
  31. '  EditDef         120  Edit configuration parameters
  32. '  FileNameCheck 20240  Matches file name to a prefix & extension
  33. '  GetArc        20140  Handle request for verbose listing
  34. '  GetCommand      101  Get RBBS-PC's node id from command line
  35. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  36. '  GoIdle           90  Release resources when waiting for keyboard input
  37. '  KillMsg        3952  Delete old or unnecessary messages
  38. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  39. '  LineEdit       3700  Edit a line while minimizing string space consumption
  40. '  LogError      13660  Log error message to CALLERS file
  41. '  LPrnt          1480  Subroutine to write to local display
  42. '  MLInit            8  Handle MultiLink initialization/de-initialization
  43. '  MsgProt        2055  Sets protection for a message
  44. '  MessageTo      2018  Sets who a message is to
  45. '  PageLen        5200  Change page length
  46. '  ParseIt        1637  Parses a string
  47. '  PassWrd         660  Verify user & message passwords
  48. '  PopCmdStack    1650  Get user input, 1st checking command stack
  49. '  PScrn          1483  Print to display
  50. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  51. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  52. '  QuickTPut1     1478  Outputs short string following by CR LF
  53. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  54. '  RecoverMsg    10410  Recover a deleted message
  55. '  RemNonAlf      5100  Removes non-alpha characters from a string
  56. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  57. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  58. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  59. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  60. '  SetThread      4554  Set up request for threading thru messages
  61. '  SkipLine       1485  Write a # of blank lines to the communications port
  62. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  63. '  SecViolation   1380  Process a security violation
  64. '  SysMenu         112  Displays sysop menu/status
  65. '  SysopChat      4773  Sysop and caller chat
  66. '  TestRel         336  Tests for Reliable connect
  67. '  TGet           1498  Read a line from the communications port
  68. '  TPut           1396  Write a line to the communications port
  69. '  Trim            105  Strip leading and trailing blanks from a string
  70. '  TrimTrail       107  Strip off specified string off end of another string
  71. '  UntilRight    12878  Ask a question until user says answer is right
  72. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  73. '  VarInit         109  Initialize system variables
  74. '  ViewHelp       1330  Processes help command
  75. '  WhoCheck       2250  Checks whether a user exists in user file
  76. '  WhosOn         9801  Report status of each node - who's on
  77. '  WordInFile    10976  Find a whole word within a file/menu
  78. '
  79. '  $INCLUDE: 'RBBS-VAR.BAS'
  80. '
  81. 8 '  $SUBTITLE: 'MLInit - MultiLink initialization/deinitialization'
  82. '  $PAGE
  83. '
  84. '  NAME    -- MLInit
  85. '
  86. '  INPUTS  --  MLParm = 1             INITIALIZE AT STARTUP OR RE-
  87. '                                     CYLCE TIME
  88. '              MLParm = 2             DE-INITIALIZE ON EXITING TO
  89. '                                     A DOOR OR DOS REMOTELY
  90. '              MLParm = 3             DE-QUEUE COMMUNICATIONS PORTS
  91. '              MLParm = 4             CHECK FOR MULTILINK PRESENT
  92. '              ZDoorsTermType
  93. '              ZBaudTest!
  94. '              ZComPort$
  95. '              ZComputerType
  96. '
  97. '  OUTPUTS --  NONE
  98. '
  99. '  PURPOSE --  To test for the presence of multi-link and set
  100. '              multi link options to be compatible with RBBS-PC
  101. '
  102.       SUB MLInit (MLParm) STATIC
  103.     DEF SEG = 0
  104.     IF ZComputerType = 1 _
  105.        GOTO 10
  106.     IF NOT ZMLCom THEN _
  107.        IF ZNetworkType <> 1 THEN _
  108.           GOTO 10
  109.     ZMultiLinkPresent = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  110.     IF ZMultiLinkPresent = 0 THEN _
  111.        GOTO 10
  112.     ON MLParm GOSUB 30,20,60,10
  113. 10  DEF SEG
  114.     EXIT SUB
  115. 20  IF ZDoorsTermType < 1 THEN _
  116.        RETURN
  117.     DEF SEG = ZMultiLinkPresent
  118.     GOSUB 60
  119. ' **************     MLUTIL BAUD n (where n = ZBaudTest!)  ******
  120.     WasAX = &H600
  121.     WasBX = ZBaudTest!   ' Tell ML the baud rate
  122.     GOSUB 80
  123. ' **************     MLUTIL TERM n (where n = ZDoorsTermType) ****
  124.     WasAX = &H700 + ZDoorsTermType
  125.     GOSUB 80         ' Tell ML the terminal type
  126. ' *********          MLINK /port       ***********
  127. '                    ' Tell ML the communications port
  128.     POKE (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC),ASC(RIGHT$(ZComPort$,1)) - 48
  129. ' ************       MLUTIL SCMON       *************
  130.     WasAX = &HB01
  131.     WasBX = 0           ' Tell ML to start monitoring the carrier
  132.     GOSUB 80
  133.     RETURN
  134. ' **************     MLUTIL CCMON       ***************
  135. 30  WasAX = &HB00       ' Turn off ML's carrier monitoring.
  136.     WasBX = 0
  137.     GOSUB 80
  138. ' **************     MLUTIL TERM 1       *************
  139.     WasAX = &H701       ' Change terminal type to ML type 1.
  140.     WasBX = 0
  141.     GOSUB 80
  142. ' *******  MLINK /port (where port = 9 if ML 3.03 or earlier  ******
  143. ' *******            port = 0 if ML 4.00 or greater           ******
  144.     DEF SEG = ZMultiLinkPresent
  145.     MultiLinkCommPort = (&H64 + PEEK(&H58) + 256 * PEEK(&H59) + &HC)
  146.     MultiLinkVersion = PEEK(&H1) + 256 * PEEK(&H2)
  147.     IF PEEK(MultiLinkCommPort) = &H1 OR _
  148.        PEEK(MultiLinkCommPort) = &H2 THEN _
  149.        IF MultiLinkVersion > 5000 THEN _
  150.           POKE (MultiLinkCommPort),&H0 _
  151.        ELSE POKE (MultiLinkCommPort),&H9
  152. ' **********         MLUTIL ENQ         **********
  153.     WasAX = &H1        ' Tell ML to conditional enque on the comm. port
  154.     GOSUB 70
  155. ' **********         MLUTIL BAUD 19200      *********
  156.     WasAX = &H600       ' Tell ML to reset the buad rate (19200 BAUD)
  157.     WasBX = 19200
  158.     GOSUB 80
  159.     RETURN
  160. ' **********         MLUTIL DEQ         *********
  161. 60 WasAX = &H100        ' Tell ML to unconditionally deque the comm. port
  162. 70 WasBX = -4
  163.    IF ZComPort$ = "COM2" THEN _
  164.       WasBX = -3
  165.    IF ZComPort$ = "COM0" THEN _
  166.       RETURN
  167. ' ******  MULTI-LINK PROGRAMMING SUPPORT INTERFACE  *******
  168. 80 CALL RBBSML(WasAX,WasBX)
  169.    RETURN
  170.    END SUB
  171. 90 '  $SUBTITLE: 'GoIdle - release control when waiting'
  172. '  $PAGE
  173. '
  174. '  NAME    -- GoIdle
  175. '
  176. '  INPUTS  -- ZMLCom
  177. '             ZNetworkType
  178. '
  179. '  OUTPUTS --  NONE
  180. '
  181. '  PURPOSE --  To relinquish control when RBBS-PC is waiting for
  182. '              input from the communications port
  183. '
  184.       SUB GoIdle STATIC
  185.    IF ZMLCom OR ZNetworkType = 1 THEN _
  186.       CALL MLInit(5) : _
  187.       EXIT SUB
  188.    CALL GiveBack
  189.    END SUB
  190. 97 '  $SUBTITLE: 'CopyRight - subroutine to display RBBS-PC copyright'
  191. '  $PAGE
  192. '
  193. '  NAME    -- CopyRight
  194. '
  195. '  INPUTS  --  NONE
  196. '
  197. '  OUTPUTS --  NONE
  198. '
  199. '  PURPOSE --  To display RBBS-PC's copyright notice on the local screen
  200. '
  201.       SUB CopyRight STATIC
  202.    ZWasA = (ZRecycleToDos OR ZDebug OR ZNodeRecIndex > 2)
  203.    IF ZWasA THEN _
  204.       EXIT SUB
  205.    WIDTH 80
  206.    REDIM ZOutTxt$(11)
  207.    ZOutTxt$(1) = "If you use RBBS-PC CPC17.3, please consider contributing to"
  208.    ZOutTxt$(2) = ""
  209.    ZOutTxt$(3) = "             Capital PC Software Exchange"
  210.    ZOutTxt$(4) = "                 Post Office Box 6128"
  211.    ZOutTxt$(5) = "            Silver Spring, Maryland  20906"
  212.    ZOutTxt$(6) = ""
  213.    ZOutTxt$(7) = "You are free to copy and share RBBS-PC CPC17.3 provided"
  214.    ZOutTxt$(08)= "  1.  This program is distributed unmodified"
  215.    ZOutTxt$(09)= "  2.  No fee or consideration is charged for RBBS-PC itself"
  216.    ZOutTxt$(10)= "  3.  This notice is not bypassed or removed."
  217.    CLS
  218.    KEY OFF
  219.    LOCATE ,,0
  220.    ZSnoop = -1
  221.    ZLocalUser = -1
  222.    CALL LPrnt(SPACE$(60) + "tm",1)
  223.    CALL LPrnt(SPACE$(16) + STRING$(15,205) + " U S E R W A R E " + STRING$(15,205),1)
  224.    CALL SkipLine(1)
  225.    CALL LPrnt(SPACE$(17) + "Capital PC User Group User-Supported Software",1)
  226.    CALL SkipLine (1)
  227.    CALL LPrnt(SPACE$(5) + CHR$(214) + STRING$(66,196) + CHR$(183),1)
  228.    FOR WasI = 1 TO 10
  229.       CALL LPrnt(SPACE$(5) + CHR$(186) + "    " + ZOutTxt$(WasI) + SPACE$(62 - LEN(ZOutTxt$(WasI))) + CHR$(186),1)
  230.    NEXT
  231.    CALL LPrnt(SPACE$(5) + CHR$(211) + STRING$(66,196) + CHR$(189),1)
  232.    CALL LPrnt(SPACE$(5) + "Copyright (c) 1983-90 Tom Mack, 39 Cranbury Drive, Trumbull, CT 06611",1)
  233.    CALL DelayTime (8)
  234.    ZSnoop = 0
  235.    END SUB
  236. 101 ' $SUBTITLE: 'GetCommand - sub to get command from command line'
  237. ' $PAGE
  238. '
  239. '  NAME    -- GetCommand
  240. '
  241. '  INPUTS  --     PARAMETER                    MEANING
  242. '             ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE TO
  243. '                                  USE AS A MODEL WHEN CREATING THE
  244. '                                  .DEF FILE NAME TO BE USED BY THIS
  245. '                                  COPY OF RBBS-PC.
  246. '
  247. '             COMMAND LINE         COMMAND LINE USED TO INVOKE
  248. '                                  RBBS-PC IN THE FORM:
  249. '
  250. '       RBBS-PC.EXE x filename DEBUG /time /baud /reliable
  251. '
  252. '   WHERE THE OPTIONAL PARAMETERS ARE:
  253. '
  254. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  255. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  256. ' DEBUG    IS A DEBUGGING Switch
  257. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  258. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  259. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  260. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  261. '             PROGRAM
  262. ' /reliable IS IF RELIABLE MODE WAS DETECTED BY A HOST MAILER
  263. '
  264. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  265. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  266. '
  267. '  OUTPUTS -- ZConfigFileName$     NAME OF RBBS-PC ".DEF" FILE FOR
  268. '                                  THIS COPY OF RBBS-PC TO USE
  269. '             ZNodeRecIndex    RECORD NUMBER WITHIN THE
  270. '                                  MESSAGES FILE FOR THIS "NODE"
  271. '                                  (RANGE IS 2 TO 36)
  272. '
  273. '  PURPOSE --  To get node id from command line and determine if rbbs
  274. '              is being run as a door
  275. '
  276.       SUB GetCommand (PassedDebug,NetTime$,ZNetBaud$,ZNetReliable$) STATIC
  277.       STATIC ZDebug
  278. '
  279. '
  280. ' *  GET NODE ID FROM COMMAND LINE
  281. '
  282. '
  283.       WasPM$ = COMMAND$
  284.       CALL AllCaps(WasPM$)
  285.       IF INSTR(WasPM$,"/") = 0 THEN _
  286.          GOTO 103
  287. '
  288. '
  289. ' * PARSE THE COMMAND LINE FOR THREE POSITIONAL SWITCHES FOR NET MAIL
  290. '
  291. '
  292.       CmdLine$ = MID$(WasPM$,INSTR(WasPM$,"/"))
  293.       WasPM$ = LEFT$(WasPM$,INSTR(WasPM$,"/") - 1)
  294.       ZWasA = 0
  295.       FOR WasX = 1 TO LEN(CmdLine$)
  296.           IF MID$(CmdLine$,WasX,1) = "/" THEN _
  297.              ZWasA = ZWasA + 1 : _
  298.              ZSubDir$(ZWasA) = "" _
  299.           ELSE ZSubDir$(ZWasA) = ZSubDir$(ZWasA) + MID$(CmdLine$,WasX,1)
  300.       NEXT
  301.       NetTime$ = ZSubDir$(1)
  302.       IF ZWasA > 1 THEN _
  303.          ZNetBaud$ = ZSubDir$(2)
  304.       IF ZWasA > 2 THEN _
  305.          ZNetReliable$ = ZSubDir$(3)
  306.       CALL Trim(NetTime$)
  307.       CALL Trim(ZNetBaud$)
  308.       CALL Trim(ZNetReliable$)
  309. 103   ZWasA = INSTR(WasPM$,"DEBUG")
  310.       IF ZWasA > 0 THEN _
  311.          ZDebug = -1 : _
  312.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  313.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  314.       PassedDebug = ZDebug
  315.       ZWasA = INSTR(WasPM$,"LOCAL")
  316.       IF ZWasA > 0 THEN _
  317.          ZComPort$ = "COM0" : _
  318.          WasPM$ = LEFT$(WasPM$,ZWasA - 1) + _
  319.                RIGHT$(WasPM$,LEN(WasPM$) - ZWasA - 4)
  320.       IF LEN(WasPM$) = 0 THEN _
  321.          WasPM$ = "-"
  322.       ZNodeRecIndex = INSTR("-1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ",LEFT$(WasPM$,1))
  323.       IF ZNodeRecIndex < 2 THEN _
  324.          ZNodeRecIndex = 2
  325.       ZNodeID$ = MID$(STR$(ZNodeRecIndex-1),2)
  326.       IF ZNodeRecIndex > 10 THEN _
  327.          ZNodeFileID$ = LEFT$(WasPM$,1) _
  328.       ELSE ZNodeFileID$ = ZNodeID$
  329.       IF ZNodeID$ <> "1" THEN _
  330.          ZLibNodeID$ = ZNodeFileID$
  331.       IF LEN(WasPM$) > 2 AND MID$(WasPM$,2,1) = " " THEN _
  332.          ZConfigFileName$ = MID$(WasPM$,3)_
  333.       ELSE MID$(ZConfigFileName$,5,1) = WasPM$
  334.       ZOrigCnfg$ = ZConfigFileName$
  335.       END SUB
  336. 105 ' $SUBTITLE: 'Trim - sub to eliminate leading/trailing blanks'
  337. ' $PAGE
  338. '
  339. '  NAME    -- Trim
  340. '
  341. '  INPUTS  --  PARAMETER                    MEANING
  342. '              TrimParm$           STRING THAT IS TO HAVE LEADING
  343. '                                  AND TRAILING BLANKS ELIMINATED FROM
  344. '
  345. '  OUTPUTS --  TrimParm$           STRING WITH NO LEADING OR TRAILING
  346. '                                   BLANKS
  347. '
  348. '  PURPOSE --  To strip leading and trailing blanks
  349. '
  350.       SUB Trim (TrimParm$) STATIC
  351.       WasL = INSTR(TrimParm$," ")
  352.       IF WasL < 1 THEN _
  353.          EXIT SUB
  354.       IF WasL = 1 THEN _
  355.          WHILE LEFT$(TrimParm$,1) = " " : _
  356.             TrimParm$ = RIGHT$(TrimParm$,LEN(TrimParm$) - 1) : _
  357.          WEND
  358.       CALL TrimTrail (TrimParm$," ")
  359.       END SUB
  360. '
  361. 107 '  $SUBTITLE: 'TrimTrail - sub to trim off trailing characters'
  362. '  $PAGE
  363. '
  364. '  NAME    --  TrimTrail
  365. '
  366. '  INPUTS  --  PARAMETER           MEANING
  367. '              TrimParm$  WHAT STRING TO Trim FROM
  368. '              TrimThis$  WHAT CHARACTER TO Trim OFF END
  369. '
  370. '  OUTPUTS --  NONE
  371. '
  372. '  PURPOSE --  To remove all occurences of a character from end of string
  373. '
  374.       SUB TrimTrail (TrimParm$,TrimThis$) STATIC
  375.       IF RIGHT$(TrimParm$, 1) <> TrimThis$ THEN _
  376.          EXIT SUB
  377.       WasJ = LEN(TrimParm$) - 1
  378. 108   IF WasJ > 0 THEN _
  379.          IF MID$(TrimParm$, WasJ, 1) = TrimThis$ THEN _
  380.             WasJ = WasJ - 1 : _
  381.             GOTO 108
  382.       TrimParm$ = LEFT$(TrimParm$, WasJ)
  383.       END SUB
  384. '
  385. 109 '  $SUBTITLE: 'VarInit - subroutine to initialize system variables'
  386. '  $PAGE
  387. '
  388. '  NAME    --  VarInit
  389. '
  390. '  INPUTS  --  PARAMETER           MEANING
  391. '              NONE
  392. '
  393. '  OUTPUTS --  NONE
  394. '
  395. '  PURPOSE --  To initialize system variable
  396. '
  397.       SUB VarInit STATIC
  398.     ZAcknowledge$ = CHR$(6)
  399.     ZAckChar$ = "C" + _
  400.             ZAcknowledge$
  401.     ZActiveMenu$ = "B"
  402.     ZActiveMessage$ = CHR$(225)
  403.     ZBackSpace$ = CHR$(8) + _
  404.                  CHR$(32) + _
  405.                  CHR$(8)
  406.     ZBackArrow$ = CHR$(29) + _
  407.                   CHR$(32) + _
  408.                   CHR$(29)
  409.     ZBaudRates$ = "      300  450 1200 2400 4800 96001920038400"
  410.     ZBellRinger$ = CHR$(7)
  411.     ZBulletinMenu$ = ""
  412.     ZWasCL = 24
  413.     ZCancel$ = CHR$(24)
  414.     ZColorReset$ = CHR$(27) + _
  415.                    "[00;37;40m"
  416.     ZConfigFileName$ = "RBBS-PC.DEF"
  417.     ZCarriageReturn$ = CHR$(13)
  418.     ZDeletedMsg$ = CHR$(226)
  419.     ZDosVersion = 2
  420.     ZEndTransmission$ = CHR$(4)
  421.     ZEscape$ = CHR$(27)
  422.     ZExpectActiveModem = 0
  423.     ZFalse = 0
  424.     ZF1Key = 59
  425.     ZF10Key = 68
  426.     ZConfName$ = "MAIN"
  427.     CALL SetHiLite (ZTrue)
  428.     ZHomeConf$ = ""
  429.     ZInConfMenu = -1
  430.     ZLastCommand$ = "M "
  431.     ZLimitMinsPerSession = 0
  432.     ZLineFeed$ = CHR$(10)
  433.     ZLineFeeds = NOT ZFalse
  434.     ZLineEditChk$ = CHR$(9) + _
  435.                     ZLineFeed$ + _
  436.                     CHR$(11) + _
  437.                     CHR$(12) + _
  438.                     CHR$(127) + _
  439.                     CHR$(8) + _
  440.                     ZBellRinger$ + _
  441.                     CHR$(26) + _
  442.                     CHR$(227)
  443.     ZLineMes$ = SPACE$(78)          ' fixed length string workspace
  444.     ZLockStatus$ = "UM UU UB UD"
  445.     ZMenuIndex = 2
  446.     ZNAK$ = CHR$(21)
  447.     ZNoAdvance = ZFalse
  448.     ZPageLength = 23
  449.     ZParseOff = ZFalse
  450.     ZPressEnter$ = " (Press [ENTER] to quit)"
  451.     ZPressEnterExpert$ = " ([ENTER] quits)"
  452.     ZPressEnterNovice$ = ZPressEnter$
  453.     ZPrivateDoor = ZFalse
  454.     ZRightMargin = 72
  455.     ZReturnLineFeed$ = ZCarriageReturn$ + _
  456.                         ZLineFeed$
  457.     ZSmartTable$ = "CS PB NS FN LN SL DT TM TR TE TL RP RR CT " + _
  458.                    "C1 C2 C3 C4 C0 DD BD DB UB DL UL FI VY VN " + _
  459.                    "TY TN BN ND FS LS"
  460.     ZStartOfHeader$ = CHR$(1)
  461.     ZTimeLoggedOn$ = SPACE$(8)
  462.     ZTrue = NOT ZFalse
  463.     ZUpInc = -1
  464.     ZXOff$ = CHR$(19)
  465.     ZXOn$ = CHR$(17)
  466.     ZInterrupOn$ = CHR$(11) + ZCancel$ + ZXOff$ + ZXOn$ + ZCarriageReturn$
  467.     ZOptionEnd$ = ZReturnLineFeed$ + " ,("
  468.     ZCrLf$ = ZCarriageReturn$ + ZLineFeed$
  469.     ZWasLG$(1) = "Registration Check Failed"
  470.     ZWasLG$(2) = "Sysop name attempted"
  471.     ZWasLG$(3) = "Locked out attempt"
  472.     ZWasLG$(4) = "Password Attempt Failed"
  473.     ZWasLG$(5) = "Auto Lockout done"
  474.     ZWasLG$(6) = "Name in use on another Node!"
  475.     ZWasLG$(7) = ""
  476.     ZWasLG$(8) = "Locked reason read!"
  477.     ZWasLG$(9) = "Expired Registration"
  478.     END SUB
  479. '
  480. 112 ' $SUBTITLE: 'SysMenu - sub to display RBBS-PC SYSOP menu'
  481. '  $PAGE
  482. '
  483. '  NAME    --  SysMenu
  484. '
  485. '  INPUTS  --  PARAMETER           MEANING
  486. '
  487. '  OUTPUTS --  NONE
  488. '
  489. '  PURPOSE --  TO DISPLAY RBBS-PC's SYSOP MENU ON THE LOCAL SCREEN
  490. '
  491.     SUB SysMenu STATIC
  492.     ZLocalUser = ZTrue
  493.     ZSnoop = ZTrue
  494.     ZNonStop = ZTrue
  495.     CALL CheckTime (TIMER, ZDelay!, 1)
  496.     CLS
  497.     ZStopInterrupts = ZTrue
  498.     ZBypassTimeCheck = ZTrue
  499.     CALL BufFile ("MENU0",WasX)
  500.     ZNonStop = ZFalse
  501.     ZBypassTimeCheck = ZFalse
  502.     ZLocalUser = ZFalse
  503.     IF NOT ZOK THEN _
  504.        CALL LPrnt("MENU0 not on default drive",1)
  505.     LOCATE 2,18
  506.     CALL LPrnt(LEFT$(ZVersionID$,8),0)
  507.     LOCATE 2,42
  508.     CALL LPrnt(ZNodeID$,0)
  509.     LOCATE 2,60
  510.     WasX$ = DATE$
  511.     CALL LPrnt(LEFT$(WasX$,6) + RIGHT$(WasX$,2),0)
  512.     LOCATE 2,74
  513.     CALL LPrnt(LEFT$(TIME$,5),0)
  514.     IF ZFMSDirectory$ <> "" THEN _
  515.        LOCATE 6,76 : _
  516.        CALL LPrnt("YES",0)
  517.     IF ZExtendedLogging THEN _
  518.        LOCATE 8,76 : _
  519.        CALL LPrnt("YES",0)
  520.     IF ZFossil THEN _
  521.        LOCATE 10,76 : _
  522.        CALL LPrnt("YES",0)
  523.     LOCATE 12,75 : _
  524.     CALL LPrnt(ZComPort$,0)
  525.     LOCATE 14,75
  526.     CALL LPrnt (STR$(CINT(FRE("A")/1024)) + "k",0)
  527.     IF ZDebug THEN _
  528.        LOCATE 22,76 : _
  529.        CALL LPrnt("Yes",0)
  530.     END SUB
  531. '
  532. 120 '  $SUBTITLE: 'EditDef - sub to edit config parameters'
  533. '  $PAGE
  534. '
  535. '  NAME    -- EditDef
  536. '
  537. '  INPUTS  --     PARAMETER                    MEANING
  538. '
  539. '  OUTPUTS --                          OUTPUT STRING
  540. '
  541. '  PURPOSE -- Interpretes and adjusts stored configuration parameters
  542. '
  543.       SUB EditDef STATIC
  544.       ZAllOpts$ = ZMainCmds$ + _
  545.                   ZFileCmd$ + _
  546.                   ZUtilCmds$ + _
  547.                   ZLibCmds$ + _
  548.                   ZGlobalCmnds$ + _
  549.                   ZSysopCmds$
  550.       ZHelpExtension$ = "." + _
  551.                         ZHelpExtension$
  552.       ZCompressedExt$ = ZDefaultExtension$
  553.       ZWasQ = INSTR(ZDefaultExtension$,".")
  554.       IF ZWasQ > 0 THEN _
  555.          ZDefaultExtension$ = LEFT$(ZDefaultExtension$, ZWasQ-1)
  556.       ZCurDirPath$ = ZDirPath$
  557.       ZBegMain = 1
  558.       ZBegFile = LEN(ZMainCmds$) + ZBegMain
  559.       ZBegUtil = LEN(ZFileCmd$) + ZBegFile
  560.       ZBegLibrary = LEN(ZUtilCmds$) + ZBegUtil
  561.       ZHelp$(3) = ZHelpPath$ + _
  562.                  ZHelp$(3)
  563.       ZHelp$(4) = ZHelpPath$ + _
  564.                  ZHelp$(4)
  565.       ZHelp$(7) = ZHelpPath$ + _
  566.                  ZHelp$(7)
  567.       ZHelp$(9) = ZHelpPath$ + _
  568.                  ZHelp$(9)
  569.       CALL BreakFileName (ZWelcomeFile$,ZWelcomeFileDrvPath$,Prefix$,_
  570.                      Extension$,ZTrue)
  571.      CALL ASCIICodes ("[","]",ZDefaultLineACK$)
  572.      CALL ASCIICodes ("[","]",ZHostEchoOn$)
  573.      CALL ASCIICodes ("[","]",ZHostEchoOff$)
  574.      CALL ASCIICodes ("[","]",ZEmphasizeOffDef$)
  575.      CALL ASCIICodes ("[","]",ZEmphasizeOnDef$)
  576.      ZDR1$ = ZFG1Def$
  577.      ZDR2$ = ZFG2Def$
  578.      ZDR3$ = ZFG3Def$
  579.      ZDR4$ = ZFG4Def$
  580.      IF ZSubParm = -62 THEN _
  581.         EXIT SUB
  582.      ZLocalUserMode = (RIGHT$(ZComPort$,1) < "1")
  583.      IF ZLocalUserMode THEN _
  584.         ZRecycleToDos = ZTrue
  585.      ZEchoer$ = ZDefaultEchoer$
  586.      IF LEN(ZScreenOutMsg$) < 2 THEN _
  587.         ZScreenOutMsg$ = ZStartOfHeader$
  588.      ZSmartTextCode$ = CHR$(ZSmartTextCode)
  589.      IF ZMaxWorkVar < 13 THEN _
  590.         ZMaxWorkVar = 13
  591. '
  592. ' ***  ESTABLISH RBBS-PC'S DOS SUBDIRECTORIES USAGE  ***
  593. '
  594.     IF ZMainFMSDir$ <> "" THEN _
  595.        ZFMSDirectory$ = ZDirPath$ + _
  596.                         ZMainFMSDir$ + _
  597.                         "." + _
  598.                         ZMainDirExtension$ : _
  599.        ZActiveFMSDir$ = ZFMSDirectory$ : _
  600.        ZLibDir$ = ZLibDirPath$ + _
  601.                             ZMainFMSDir$ + _
  602.                             "." + _
  603.                             ZLibDirExtension$
  604.     ZUpcatHelp$ = ZHelpPath$ + _
  605.                   ZUpcatHelp$ + _
  606.                   ZHelpExtension$
  607.     IF ZSubDirCount < 1 THEN _
  608.        GOTO 123
  609.     FOR ZSubDirIndex = 1 TO ZSubDirCount
  610.        INPUT #2,ZSubDir$
  611.        IF RIGHT$(ZSubDir$,1) <> "\" THEN _
  612.          ZSubDir$(ZSubDirIndex) = ZSubDir$ + _
  613.                                  "\" _
  614.        ELSE ZSubDir$(ZSubDirIndex) = ZSubDir$
  615.     NEXT
  616.     GOTO 125
  617. 123 FOR ZSubDirIndex = 1 TO LEN(ZDnldDrives$) - 1
  618.        ZSubDir$(ZSubDirIndex) = MID$(ZDnldDrives$,ZSubDirIndex,1) + _
  619.                                ":"
  620.     NEXT
  621.     ZSubDirCount = LEN(ZDnldDrives$) - 1
  622. '
  623. ' *****  SETUP UPLOAD DRIVE AND DIRECTORY.NAME  ***
  624. '
  625. 125 ZUpldDirCheck$ = ZUpldDir$
  626.     ZSubDirCount = ZSubDirCount + 1
  627.     IF ZUpldToSubdir THEN _
  628.        ZSubDir$(ZSubDirCount) = ZUpldSubdir$ + _
  629.                                "\" _
  630.     ELSE ZSubDir$(ZSubDirCount) = RIGHT$(ZDnldDrives$,1) + _
  631.                                  ":"
  632.     ZUpldDir$ = ZUpldDir$ + _
  633.                         "." + _
  634.                         ZMainDirExtension$
  635.     CALL SearchArray (ZSubDir$(ZSubDirCount),ZSubDir$(),ZSubDirCount-1,Found)
  636.     ZCanDnldFromUp = (Found > 0)
  637.     ZUpldDir$ = ZUpldPath$ + _
  638.                         ZUpldDir$
  639. 126 CLOSE #2
  640.     IF ZLibDrive$ <> "" THEN _
  641.        ZLibType = 1
  642.     ZSubParm = -10
  643.     CALL Carrier
  644.     IF ZSubParm = -1 THEN _
  645.        IF ZLibDrive$ <> "" THEN _
  646.           CALL ChangeDir (ZLibDrive$ + _
  647.                          "\") : _
  648.           CALL KillWork (ZLibWorkDiskPath$ + _
  649.                         ZLibNodeID$ + _
  650.                         "DK*.ARC") : _
  651.                         ZErrCode = 0
  652. '
  653. ' ***  INITIALIZE OMNINET INTERFACE IF OMNINET IN USE  ***
  654. '
  655. 128 IF ZNetworkType = 2 THEN _
  656.        ZWasCN$ = SPACE$(535) : _
  657.        CALL InitIO(ZWasA)
  658.        END SUB
  659. '
  660. 129 '  $SUBTITLE: 'ASCIICodes - subrotuine to allow any ASCII codes'
  661. '  $PAGE
  662. '
  663. '  NAME    -- ASCIICodes
  664. '
  665. '  INPUTS  --     PARAMETER                    MEANING
  666. '                 LeftParen$           MARKS BEGINNING OF #
  667. '                 RightParen$          MARKS END OF #
  668. '                 Strng$                INPUT STRING
  669. '
  670. '  OUTPUTS --    Strng$                OUTPUT STRING
  671. '
  672. '  PURPOSE -- To allow a config string to have any ascii values.
  673. '             characters not enclosed taken as is.  Enclosed
  674. '             characters interpreted as value of ascii code.
  675. '             (e.g. "123[32]4" is interpreted as "123 4").
  676. '
  677.     SUB ASCIICodes (LeftParen$,RightParen$,Strng$) STATIC
  678.     IF LEN(Strng$) < 1 THEN _
  679.        EXIT SUB
  680.     Start = 1
  681.     WasL = LEN(Strng$)
  682.     ZUserIn$ = Strng$ + _
  683.          LeftParen$
  684.     WasX = INSTR(ZUserIn$,LeftParen$)
  685.     NewString$ = ""
  686.     WHILE Start <= WasL
  687.        NewString$ = NewString$ + _
  688.                     MID$(ZUserIn$,Start,WasX - Start)
  689.        WasY = INSTR(WasX,ZUserIn$,RightParen$)
  690.        IF WasY > 0 THEN _
  691.           WasK = VAL(MID$(ZUserIn$,WasX + 1,WasY - WasX - 1)) : _
  692.           NewString$ = NewString$ + _
  693.                        CHR$(WasK) : _
  694.           Start = WasY + 1 _
  695.        ELSE NewString$ = NewString$ + _
  696.                          MID$(ZUserIn$,WasX,WasL + 1 - WasX) : _
  697.             Start = WasL + 1
  698.        WasX = INSTR(Start,ZUserIn$,LeftParen$)
  699.     WEND
  700.     Strng$ = NewString$
  701.     END SUB
  702. 200 ' $SUBTITLE: 'AnswerIt - sub to establish connection'
  703. ' $PAGE
  704. '
  705. '  NAME    -- AnswerIt
  706. '
  707. '  INPUTS  --     PARAMETER                    MEANING
  708. '                 ZSubParm = 1           WAIT FOR PHONE TO RING
  709. '                          = 2           CONTINUE LOOKING FOR CONNECT
  710. '                          = 3           RENTRY AFTER FUNCTION KEY
  711. '                          = 4           GO ON LINE IMMEDIATELY
  712. '                 ZBG                    LOCAL DISPLAY'S BACKGROUND
  713. '                 ZBorder                LOCAL DISPLAY'S BORDER COLOR
  714. '                 ZComPort$              COMMUNICATIONS PORT NAME
  715. '                 ZComputerType          TYPE OF COMPUTER RUNNING ON
  716. '                 ZDumbModem             NON-HAYES TYPE MODEM FLAG
  717. '                 ZExtendedLogging       EXTENDED CALLERS LOG FLAG
  718. '                 ZFG                    LOCAL DISPLAY'S FOREGROUND
  719. '                 ZModemAnswerCmd$       COMMAND TO ANSWER PHONE
  720. '                 ZModemCntlReg          LOCATION WasOF MODEM CNTRL. REG
  721. '                 ZModemCountRingsCmd$   COMMAND TO COUNT PHONE RINGS
  722. '                 ZModemInitBaud$        BAUD AT WHICH TO OPEN COMM.
  723. '                 ZModemResetCmd$        COMMAND TO RESET THE MODEM
  724. '                 ZModemStatusReg        LOCATION OF MODEM STATUS REG
  725. '                 ZPrinter               FLAG TO PRINT ON LOCAL PRT.
  726. '                 ZRequiredRings         NUMBER OF RINGS TO ANSWER ON
  727. '                 ZSnoop                 FLAG TO DISPLAY ON LOCAL PC
  728. '                 ZSysopNext             FLAG TO GIVE SYSOP CONTROL
  729. '
  730. '  OUTPUTSS --    BaudTest!              BAUD RATE TO SET RS232 AT
  731. '                 ZEightBit              PARITY INDICATOR
  732. '                 ZReliableMode          INDICATES MODEM-SUPPLIED
  733. '                                        "ERROR-FREE" Protocol ACTIVE
  734. '                 ZSubParm          = 1  Carrier DETECT Found (I.E.
  735. '                                        MODEM AUTO-ANSWERED).
  736. '                                   = 2  ANSWERED THE PHONE AND
  737. '                                        Carrier DETECT OCCURRED.
  738. '                                   = 3  SYSOP HIT "ESC" KEY ON THE
  739. '                                        LOCAL KEYBOARD.
  740. '                                   = 4  ANSWERED THE PHONE BUT NO
  741. '                                        Carrier WAS DETECTED.
  742. '                                   = 5  COMM. BUFFER OVERFLOW.
  743. '                                   = 6  FUNCTION KEY PRESSED ON THE
  744. '                                        LOCAL KEYBOARD.
  745. '
  746. '  PURPOSE -- To detect incoming call and establish connection.
  747. '
  748.       SUB AnswerIt STATIC
  749.       ZErrCode = 0
  750.       ZReliableMode = ZFalse
  751.       ZFF = ZSubParm
  752.       ZSubParm = 0
  753.       ON ZFF GOTO 201,324,245,320
  754. '
  755. '
  756. ' *  INITIALIZE MODEM AND ANNOUNCE RBBS-PC IS UP AND READY FOR CALLS
  757. '
  758. '
  759. 201 ZSubParm = -10
  760.     CALL Carrier
  761.     IF ZSubParm = 0 THEN _
  762.        GOTO 210
  763. '
  764. '
  765. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY
  766. '
  767. '
  768.     IF ZFossil THEN _
  769.        State = 0 : _
  770.        CALL FosDTR(ZComPort,State) _
  771.     ELSE OUT ZModemCntlReg,&H4
  772.     CALL DelayTime (ZModemInitWaitTime)
  773. '
  774. '
  775. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT
  776. '
  777. '
  778.     IF ZFossil THEN _
  779.        State = 1 : _
  780.        CALL FosDTR(ZComPort,State) _
  781.     ELSE OUT ZModemCntlReg,&H0
  782.     CALL DelayTime (ZModemInitWaitTime)
  783. 210 IF ZPrivateDoor THEN _
  784.        CALL Transfer : _
  785.        GOTO 235
  786.     CALL OpenCom(ZModemInitBaud$,",N,8,1")
  787. 220 CALL AMorPM
  788. 230 CALL Printit (" RBBS-PC " + ZVersionID$ + " Node " + _
  789.                     ZNodeID$ + " up " + ZTime$ + " on " + DATE$)
  790. 235 ZEightBit = ZTrue
  791.     ZSubParm = -10
  792.     CALL Carrier
  793.     IF ZSubParm = 0 AND _
  794.        ZExitToDoors THEN _
  795.        CALL ReadProf : _
  796.        ZSubParm = 1 : _
  797.        GOTO 335
  798.     IF ZSubParm = 0 AND _
  799.        ZExpectActiveModem THEN _
  800.        ZBaudTest! = VAL(ZNetBaud$) : _
  801.        CALL TestRel (ZNetReliable$) : _
  802.        GOTO 328
  803.     IF ZExpectActiveModem OR _
  804.        ZExitToDoors THEN _
  805.        ZSubParm = 4 : _
  806.        EXIT SUB
  807.     IF ZSubParm = 0 THEN _
  808.        ConnectDelay! = TIMER + ZMaxCarrierWait : _
  809.        GOTO 324
  810.     PCJr = ZFalse
  811.     IF ZComputerType = 2 AND _
  812.        ZComPort$ = "COM1" AND _
  813.        ZModemStatusReg = 1022 THEN _
  814.        ZModemGoOffHookCmd$ = CHR$(14) + _
  815.                                    "P" : _
  816.        PCJr = ZTrue
  817.     CALL SysMenu
  818.     IF PCJr THEN _
  819.        ZOutTxt$ = CHR$(14) + _
  820.             "I" _
  821.     ELSE ZOutTxt$ = ZModemResetCmd$
  822.     CALL ModemPut (ZOutTxt$)
  823.     CALL DelayTime (ZModemInitWaitTime)
  824.     IF PCJr THEN _
  825.        ZOutTxt$ = CHR$(14) + _   ' PC-JR'ZWasS MODEM COMMAND IDENTIFIER
  826.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'ZWasS MODEM
  827.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'ZWasS MODEM
  828.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  829.     ELSE ZOutTxt$ = ZModemInitCmd$
  830.     CALL ModemPut (ZOutTxt$)
  831.     IF PCJr THEN _
  832.        ZOutTxt$ = CHR$(14) + _
  833.             "F 4" : _
  834.        CALL ModemPut (ZOutTxt$)
  835.     RingBack = ZFalse
  836.     LOCATE 16,55
  837.     IF ZRequiredRings = 0 THEN _
  838.        CALL LPrnt("WAITING FOR CARRIER",0) : _
  839.        GOTO 237
  840.     IF MID$(ZModemInitCmd$, _
  841.           INSTR(ZModemInitCmd$,"S0") + 3,3) = "255" THEN _
  842.        CALL LPrnt("RING BACK SYSTEM",0) : _
  843.        RingBack = ZTrue : _
  844.        GOTO 236
  845.     CALL LPrnt(" WAITING FOR RING ",0)
  846. 236 LOCATE 16,76 : _
  847.     CALL LPrnt(MID$(STR$(ZRequiredRings),2),0)
  848. 237 LOCATE 18,76
  849.     IF ZDosANSI THEN _
  850.        CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _
  851.     ELSE CALL LPrnt ("YES",0)
  852.     COLOR ZFG,ZBG,ZBorder
  853.     LOCATE 20,56
  854. '
  855. '
  856. ' *  GET READY TO ANSWER INCOMMING CALL:
  857. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
  858. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
  859. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
  860. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND.
  861. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
  862. ' *           First CALLS AND THEN HANGS UP (I.E. RING-BACK).
  863. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
  864. '
  865. '
  866.     WasQQ = 255
  867.     WasI = INSTR(ZModemInitCmd$,"S0")
  868.     IF WasI = 0 OR PCJr THEN _
  869.        GOTO 239
  870.     IF VAL(MID$(ZModemInitCmd$,WasI + 3,3)) = 255 THEN _
  871.        WasQQ = 0 : _
  872.        ZBlk = WasQQ
  873.     ZSecsUsedSession! = TIMER
  874.     ZSubParm = 1
  875.     CALL Line25
  876.     RingAnswer = ZTrue
  877.     IF RingBack THEN _
  878.        RingAnswer = ZFalse
  879. 239 RingBackWaitStart! = 0
  880.     IF RingBack THEN _
  881.        RingBackWaitStart! = TIMER : _
  882.        COLOR 7,0,0 _
  883.     ELSE COLOR ZFG,ZBG,ZBorder
  884. 240 IF ZSysopNext THEN _
  885.        ZSubParm = 3 : _
  886.        EXIT SUB
  887. '
  888. '
  889. ' * WAIT FOR INCOMING CALLS
  890. '
  891. '
  892.     ScreenCleared = ZFalse
  893. 245 InactiveDelay! = TIMER + (60 * ZRecycleWait)
  894.     NoCall = ZTrue
  895.     CALL FlushCom (ModemResponse$)
  896.     ModemResponse$ = ""
  897. 247 IF INP(ZModemStatusReg) > 127 OR (NOT NoCall) THEN _
  898.        GOTO 274
  899.        CALL FindFKey
  900.        IF ZSubParm < 0 THEN _
  901.           EXIT SUB
  902. 250    IF ZKeyPressed$ = ZEscape$ THEN _
  903.           ZSubParm = 3 : _
  904.           EXIT SUB
  905.        IF ZKeyPressed$ <> "" THEN _
  906.           GOTO 235
  907. 260    IF RingBackWaitStart! > 0 THEN _
  908.           CALL CheckTime(RingBackWaitStart!, TempElapsed!, 2) : _
  909.           IF TempElapsed! > 45 THEN _
  910.              RingBackWaitStart! = 0 : _
  911.              RingBackCount = 0 : _
  912.              RingAnswer = ZFalse: _
  913.              IF RingBack THEN _
  914.                LOCATE 20,56 : _
  915.                CALL LPrnt("Ringback timeout" + ZPagingPtrSupport$,1)
  916. 265    CALL CheckTime(ZSecsUsedSession!, TempElapsed!, 2)
  917.        IF TempElapsed! > 120 AND NOT ScreenCleared THEN _
  918.           LOCATE ,,0 : _
  919.           CLS : _
  920.           ZWasCL = 1 : _
  921.           ScreenCleared = ZTrue : _
  922.           ZSecsUsedSession! = TIMER
  923.        IF ZTimeToDropToDos! > 0 THEN _
  924.           IF ZOldDate$ <> DATE$ THEN _
  925.           IF TIMER => ZTimeToDropToDos! AND _
  926.              TIMER < 86340 THEN _      ' Skip btw 23:59 and 00:00
  927.                 ZSubParm = 7 : _
  928.                 EXIT SUB
  929. 266    IF (INP(ZModemStatusReg) AND &H40) > 0 AND _
  930.           ZRequiredRings > 0 THEN _
  931.           GOTO 276
  932. 270    IF ZRecycleWait > 0 THEN _
  933.           CALL CheckTime(InactiveDelay!, TempElapsed!, 1) : _
  934.           IF TempElapsed! <= 0 THEN _
  935.              ZSubParm = 8 : _
  936.              EXIT SUB
  937.        CALL FlushCom (WasX$)
  938.        IF LEN(WasX$) > 0 THEN _
  939.           ModemResponse$ = ModemResponse$ + WasX$ : _
  940.           RingDetected = (INSTR(ModemResponse$,"RING") > 0) : _
  941.           ConnectDetected = (INSTR(ModemResponse$,"ONNECT") > 0) : _
  942.           NoCall = (NOT RingDetected) AND (NOT ConnectDetected)
  943.     IF RingDetected AND ZRequiredRings > 0 THEN _
  944.        MID$(ModemResponse$, INSTR(ModemResponse$,"RING")+1,1) = "A" : _
  945.        RingDetected = ZFalse : _
  946.        GOTO 276
  947.     CALL GoIdle
  948.     GOTO 247
  949. 274 IF NOT RingBack THEN _
  950.        IF ConnectDetected THEN _
  951.           GOTO 321
  952.     IF ZRequiredRings = 0 THEN _
  953.        CALL DelayTime (3) : _
  954.        GOTO 321
  955. '
  956. '
  957. ' * PREPARE TO ANSWER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 254) OR
  958. ' * THE CALL AFTER THIS CALL ON A SPECIFIED NUMBER OF RINGS (S0 = 255) --
  959. ' * "RING BACK."
  960. '
  961. '
  962. 276 CALL EofComm (Char)
  963.     IF Char <> -1 THEN _
  964.        CALL FlushCom(WasX$) : _
  965.        IF ZSubParm = - 1 THEN _
  966.           EXIT SUB
  967.     IF PCJr THEN _
  968.        GOTO 320
  969.     ZOutTxt$ = ZModemCountRingsCmd$
  970.     CALL ModemPut (ZOutTxt$)
  971.     CALL DelayTime (ZModemCmdDelayTime)
  972. 290 CALL FlushCom(WasX$)
  973.     IF ZSubParm = -1 THEN _
  974.        EXIT SUB
  975. 291 IF LEN(WasX$) = 0 THEN _
  976.        GOTO 310
  977. 292 IF INSTR(WasX$,"0") < 1 THEN _
  978.        GOTO 293
  979.     WasX$ = MID$(WasX$,INSTR(WasX$,"0"),4)
  980. 293 IF (NOT RingAnswer) AND (VAL(WasX$) < RingBackCount) THEN _
  981.        RingAnswer = ZTrue
  982. 300 RingBackCount = VAL(WasX$)
  983.     ZWasQ = RingBackCount + 1
  984.     IF (NOT RingAnswer) THEN _
  985.        ZWasQ = 0
  986. 305 LOCATE 20,56
  987.     CALL LPrnt(TIME$ + " Ring " + STR$(ZWasQ),0)
  988. 310 IF (RingBackCount + 1 < ZRequiredRings) OR _
  989.        (NOT RingAnswer) THEN _
  990.        GOTO 239
  991. 320 IF PCJr THEN _
  992.        ZOutTxt$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  993.             "T 0," + _     ' SET PC-JR'S MODEM TO TRANSPARENT MODE PERMANENTLY
  994.             "M" _          ' TELL THE PC-JR'S MODEM TO ANSWER IN DATA MODE
  995.     ELSE ZOutTxt$ = ZModemAnswerCmd$
  996.     CALL ModemPut (ZOutTxt$)
  997. '
  998. '
  999. ' *  TEST FOR Carrier PRESENT
  1000. '
  1001. '
  1002. 321 ConnectDelay! = TIMER + ZMaxCarrierWait
  1003. 322 CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1004. 323 ZSubParm = -10
  1005.     CALL Carrier
  1006.     IF ZSubParm AND _
  1007.        TempElapsed! > 0 THEN _
  1008.        GOTO 322
  1009.     IF ZSubParm THEN _
  1010.        ZSubParm = 4 : _
  1011.        EXIT SUB
  1012.     CALL DelayTime (3)
  1013. 324 ZSubParm = 0
  1014.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1015.     IF TempElapsed! <= 0 THEN _
  1016.        CALL UpdtCalr ("Connect timeout",1) : _
  1017.        ZSubParm = 4 : _
  1018.        EXIT SUB
  1019. 325 CALL FlushCom(WasX$)
  1020.     IF ZSubParm = -1 THEN _
  1021.        IF ZErrCode = 69 THEN _
  1022.           ZSubParm = 5 : _
  1023.        EXIT SUB
  1024.     ModemResponse$ = ModemResponse$ + WasX$
  1025.     IF LEN(ModemResponse$) > 200 THEN _
  1026.        ModemResponse$ = RIGHT$(ModemResponse$,20)
  1027.     CALL CheckTime(ConnectDelay!, TempElapsed!, 1)
  1028.     IF TempElapsed! <= 0 THEN _
  1029.        CALL UpdtCalr ("Connect timeout",1) : _
  1030.        ZSubParm = 4 : _
  1031.        EXIT SUB
  1032.     IF ZDumbModem THEN _
  1033.        ZBaudTest! = VAL(ZModemInitBaud$) : _
  1034.        GOTO 327
  1035.     IF INSTR(ModemResponse$,"FAST") THEN _
  1036.        ZBaudTest! = 19200 : _
  1037.        GOTO 327
  1038.     IF INSTR(ModemResponse$,"ONNECT") THEN _
  1039.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONNECT") + 7)) : _
  1040.        GOTO 327
  1041.     IF INSTR(ModemResponse$,"ONLINE") THEN _
  1042.        ZBaudTest! = VAL(MID$(ModemResponse$,INSTR(ModemResponse$,"ONLINE") + 7)) : _
  1043.        GOTO 327
  1044.     GOTO 324
  1045. 327 CALL TestRel (ModemResponse$)
  1046. 328 IF ZBaudTest! = 0 OR ZBaudTest! = 300 THEN _
  1047.        ZBaudTest! = 300 : _
  1048.        ZBPS = -1 : _
  1049.        GOTO 331
  1050.     IF ZBaudTest! = 1200 OR ZBaudTest! = 1275 THEN _
  1051.        ZBPS = -3 : _
  1052.        GOTO 331
  1053.     IF ZBaudTest! = 2400 THEN _
  1054.        ZBPS = -4 : _
  1055.        GOTO 331
  1056.     IF ZBaudTest! = 4800 OR ZBaudTest! = 9600 THEN _
  1057.        ZBPS = -4-(ZBaudTest! /4800) : _
  1058.        GOTO 331
  1059.     IF ZBaudTest! = 19200 THEN _
  1060.        ZBPS = -7 : _
  1061.        GOTO 331
  1062.     IF ZBaudTest! = 38400 THEN _
  1063.        ZBPS = -8 : _
  1064.        GOTO 331
  1065.     GOTO 324
  1066. 331 CALL SetBaud
  1067.     ZSubParm = 2
  1068. 335 DontWrite = 0
  1069.     END SUB
  1070. 336 ' $SUBTITLE: 'TestRel - Test for Reliable mode connection'
  1071. ' $PAGE
  1072. '
  1073. '  NAME    -- TestRel
  1074. '
  1075. '  INPUTS  --     PARAMETER                    MEANING
  1076. '                 Strng$                 String to check for reliable
  1077. '
  1078. '  OUTPUTS --    ZReliableMode          Reliable mode indicator
  1079. '
  1080. '  PURPOSE -- To test for reliable connect
  1081. '
  1082.     SUB TestRel (Strng$) STATIC
  1083.     ZReliableMode = ZFalse
  1084.     IF Strng$ = "" THEN _
  1085.        EXIT SUB
  1086.     IF INSTR(Strng$,"REL") OR _
  1087.        INSTR(Strng$,"R C") OR _       (ERROR CONTROL)
  1088.        INSTR(Strng$,"ARQ") OR _
  1089.        INSTR(Strng$,"LAP") OR _
  1090.        INSTR(Strng$,"AFT") OR _
  1091.        INSTR(Strng$,"MNP") THEN _
  1092.          ZReliableMode = -1
  1093.     END SUB
  1094. 455 ' $SUBTITLE: 'BadChar - sub to check user names for bad characters'
  1095. ' $PAGE
  1096. '
  1097. '  NAME    -- BadChar
  1098. '
  1099. '  INPUTS  --     PARAMETER                    MEANING
  1100. '                 PassedName$                  USER NAME
  1101. '
  1102. '  OUTPUTS --    PassedName$            USER NAME WILL CONTAIN ""
  1103. '                                       IF BAD CHARACTERS Found
  1104. '
  1105. '  PURPOSE -- To check user names for invalid characters
  1106. '
  1107.     SUB BadChar (PassedName$) STATIC
  1108.     WasJ = 1
  1109.     WasXX = LEN(PassedName$)
  1110. 457 IF WasJ > WasXX THEN _
  1111.        EXIT SUB
  1112.     WasX$ = MID$(PassedName$,WasJ,1)
  1113.     IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ '-./0123456789",WasX$) = 0 THEN _
  1114.        PassedName$ = "" : _
  1115.        EXIT SUB
  1116.     WasJ = WasJ + 1
  1117.     GOTO 457
  1118.     END SUB
  1119. 660 ' $SUBTITLE: 'PassWrd - verify User and Message passwords'
  1120. ' $PAGE
  1121. '
  1122. '  NAME    -- PassWrd
  1123. '
  1124. '  INPUTS  --     PARAMETER                    MEANING
  1125. '                 ZSubParm         = 1      VERIFY USER PASSWORD
  1126. '                                  = 2      VERIFY MESSAGE PASSWORD
  1127. '                                  = 3      VERIFY MESSAGE PASSWORD
  1128. '                                  = 4      VERIFY MESSAGE PASSWORD
  1129. '                                  = 5      VERIFY MESSAGE PASSWORD
  1130. '
  1131. '  OUTPUTS -- ZPswdFailed                   SET TO 0 IF PASSED
  1132. '                                           SET TO -1 IF FAILED
  1133. '
  1134. '  PURPOSE -- To verify user and message passwords
  1135. '
  1136.     SUB PassWrd STATIC
  1137.     ZErrCode = 0
  1138.     ON ZSubParm GOTO 665,667,670,675,677
  1139. 665 IF ZPswdSave$ = ZPswd$ THEN _
  1140.        ZPswdFailed = 0 : _
  1141.        EXIT SUB
  1142. 667 Attempts = 0
  1143. 670 Attempts = Attempts + 1
  1144.     IF Attempts > ZAttemptsAllowed THEN _
  1145.        ZPswdFailed = ZTrue : _
  1146.        EXIT SUB
  1147. 675 ZOutTxt$ = "Enter Password"
  1148.     ZHidden = ZTrue
  1149.     CALL PopCmdStack
  1150.     IF ZSubParm < 0 THEN _
  1151.        ZPswdFailed = ZTrue : _
  1152.        EXIT SUB
  1153.     ZHidden = ZFalse
  1154.     ZWasZ$ = ZUserIn$
  1155. 677 IF LEN(ZWasZ$) > 15 THEN _
  1156.        GOTO 680
  1157.     IF ZErrCode <> 0 THEN _
  1158.        GOTO 670
  1159.     CALL AllCaps (ZWasZ$)
  1160.     ZWasZ$ = ZWasZ$ + SPACE$(15 - LEN(ZWasZ$))
  1161.     IF ZPswdSave$ = ZWasZ$ THEN _
  1162.        ZPswdFailed = 0 : _
  1163.        ZOutTxt$ = "" : _
  1164.        EXIT SUB
  1165. 680 CALL QuickTPut1 ("Wrong password ")
  1166.     ZLastIndex = 0
  1167.     IF NOT ZMsgPswd THEN _
  1168.        CALL UpdtCalr (ZActiveUserName$+" PW fail: " + ZWasZ$,1)
  1169.     GOTO 670
  1170.     END SUB
  1171. 945 ' $SUBTITLE: 'Line25 - sub to build/display RBBS-PCs line 25'
  1172. ' $PAGE
  1173. '
  1174. '  NAME    -- Line25
  1175. '
  1176. '  INPUTS  --     PARAMETER                    MEANING
  1177. '                 ZSubParm           = 1  BUILD DISPLAY FOR LINE 25
  1178. '                                    = 2  UPDATE LINE 25
  1179. '                 ZLockStatus$            STATUS OF LOCKS IN A MULTI-
  1180. '                                         USER ENVIRONMENT OR TIME OF
  1181. '                                         DAY USER LOGGED ON OR THE
  1182. '                                         RE-CYCLED
  1183. '
  1184. '  OUTPUTS -- ZCursorLine                 CURRENT LINE ON SCREEN
  1185. '             ZCursorRow                  CURRENT ROW ON ZCursorLine
  1186.  
  1187. '
  1188. '  PURPOSE -- To build or update RBBS-PC's line 25 displayed
  1189. '             on the PC screen that is running RBBS-PC.
  1190. '
  1191.       SUB Line25 STATIC
  1192.       IF ZSubParm = 2 THEN _
  1193.          GOTO 950
  1194. '
  1195. '
  1196. ' *  BUILD LINE 25 DISPLAY
  1197. '
  1198. '
  1199. 949 ZLine25$ = "Node " + _
  1200.                ZNodeID$ + " " + _
  1201.                ZPageStatus$ + " " + _
  1202.                MID$("    AVL ",1 - 4 * ZSysopAvail,4) + _
  1203.                MID$("    ANY ",1 - 4 * ZSysopAnnoy,4) + _
  1204.                MID$("    LPT ",1 - 4 * ZPrinter,4) + _
  1205.                MID$("SYS",1,-3 * ZSysopNext) + _
  1206.                MID$(" XOFF",1,-5 * ZXOffEd) + _
  1207.                MID$(" CTS",1,-4 * ZNotCTS)
  1208. '
  1209. '
  1210. ' *  LINE 25 UPDATE ROUTINE
  1211. '
  1212. '
  1213. 950 IF NOT ZSnoop THEN _
  1214.        EXIT SUB
  1215.     ZCursorLine = CSRLIN
  1216.     ZCursorRow = POS(0)
  1217.     ZWasHH = LEN(ZActiveUserName$) + _
  1218.          LEN(ZWasCI$) + _
  1219.          LEN(ZLine25$) + _
  1220.          LEN(STR$(ZUserSecLevel)) + _
  1221.          18
  1222.     IF ZAutoDownYes THEN _
  1223.        ZWasHH = ZWasHH + 4
  1224.     LOCATE 25,1
  1225.     IF ZNetworkType = 0 THEN _
  1226.        IF ZAutoDownYes THEN _
  1227.           ZLockStatus$ = SPACE$(3) + _
  1228.                          "AD  " + _
  1229.                          ZTimeLoggedOn$ _
  1230.        ELSE ZLockStatus$ = SPACE$(3) + _
  1231.                            ZTimeLoggedOn$
  1232.     IF ZWasHH > 79 THEN _
  1233.        ZWasHH = 78
  1234.     ZLine25Hold$ = ZLine25$ + _
  1235.                     SPACE$(79 - ZWasHH) + _
  1236.                     STR$(ZUserSecLevel) + _
  1237.                     " " + _
  1238.                     ZActiveUserName$ + _
  1239.                     " " + _
  1240.                     ZWasCI$ + _
  1241.                     " " + _
  1242.                     ZLockStatus$
  1243.     TempBasicWrites = ZUseBASICWrites
  1244.     ZUseBASICWrites = ZTrue
  1245.     CALL LPrnt(ZLine25Hold$,0)
  1246.     ZUseBASICWrites = TempBasicWrites
  1247.     LOCATE ZCursorLine,ZCursorRow
  1248.     END SUB
  1249. 1238 ' $SUBTITLE: 'SearchCmd    - sub to search command list'
  1250. ' $PAGE
  1251. '
  1252. '  NAME    -- SearchCmd
  1253. '
  1254. '  INPUTS  -- PARAMETER             MEANING
  1255. '             StartPos         POSITION TO BEGIN SEARCH AT
  1256. '             ZAllOpts$        STRING TO SEARCH (COMMAND LIST)
  1257. '             ZWasZ$            WHAT TO LOOK FOR
  1258. '
  1259. '  OUTPUTS -- WhereFound   POSITION OF ZWasZ$ IN ZAllOpts$
  1260. '                           0 IF NOT Found
  1261. '
  1262. '  PURPOSE -- Searches valid command list for the requested
  1263. '             command.  If the sysop has configured RBBS-PC to
  1264. '             restrict commands to only those valid within the
  1265. '             RBBS-PC subsystem, then only those commands and
  1266. '             "GLOBAL" commands are valid.  Otherwise all commands
  1267. '             are valid from any of the RBBS-PC subsections.
  1268. '
  1269.      SUB SearchCmd (StartPos,WhereFound) STATIC
  1270. 1240 IF LEN(ZWasZ$) < 1 THEN _
  1271.         WhereFound = 0 : _
  1272.         EXIT SUB
  1273.      CALL Trim (ZWasZ$)
  1274.      CALL AllCaps (ZWasZ$)
  1275.      ZWasY$ = LEFT$(ZWasZ$,1)
  1276.      WhereFound = INSTR(StartPos,ZAllOpts$,ZWasY$)
  1277.      IF WhereFound = 0 THEN _  'Not found: decide whether to hunt further
  1278.         IF StartPos < 2 OR ZRestrictValidCmds THEN _
  1279.            GOTO 1242 _  ' fully searched or restricted
  1280.         ELSE WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _ 'hunt further
  1281.              GOTO 1242
  1282.      IF WhereFound => ZBegLibrary THEN _
  1283.         IF WhereFound < LEN(ZAllOpts$) - 11 THEN _
  1284.            IF ZLibType = 0 THEN _
  1285.               WhereFound = INSTR(WhereFound+1,AllOpt$,ZWasY$) : _
  1286.               IF WhereFound = 0 THEN _
  1287.                  WhereFound = INSTR(1,ZAllOpts$,ZWasY$) : _
  1288.                  IF WhereFound >= ZBegLibrary OR WhereFound = 0 THEN _
  1289.                     WhereFound = 0 : _
  1290.                     GOTO 1242
  1291.      IF NOT ZRestrictValidCmds THEN _
  1292.         GOTO 1242            ' everything found valid
  1293. '
  1294. '
  1295. ' * RESTRICT COMMANDS TO SUBSYSTEMS (EXCEPT GLOBAL AND SYSOP)
  1296. '
  1297. '
  1298.      IF WhereFound > LEN(ZAllOpts$) - 11 THEN _
  1299.         IF ZUserSecLevel < ZOptSec(WhereFound) THEN _
  1300.            WhereFound = 0 : _
  1301.            EXIT SUB _
  1302.         ELSE GOTO 1242
  1303.      IF MID$(ZOrigCommands$,WhereFound,1) = "G" THEN _
  1304.         GOTO 1242          ' ACCEPT GOODBYE/GRAPHICS
  1305.      IF (WhereFound < StartPos) OR _
  1306.         (StartPos < ZBegFile AND WhereFound => ZBegFile ) OR _
  1307.         (StartPos < ZBegUtil AND WhereFound => ZBegUtil ) OR _
  1308.         (StartPos < ZBegLibrary AND WhereFound => ZBegLibrary ) THEN _
  1309.            WhereFound = 0                 ' REJECT: NOT IN Section
  1310. 1242 IF WhereFound > 0 THEN _
  1311.         LSET ZLastCommand$ = ZActiveMenu$ + MID$(ZOrigCommands$,WhereFound) : _
  1312.         EXIT SUB
  1313.      IF ZMacroActive OR LEN(ZWasZ$) <> 1 THEN _
  1314.         EXIT SUB
  1315.      CALL Macro (ZWasZ$,Found)
  1316.      IF Found THEN _
  1317.         CALL FDMACEXE : _
  1318.         ZWasZ$ = ZUserIn$(1) : _
  1319.         GOTO 1240
  1320.      END SUB
  1321. 1320 ' $SUBTITLE: 'CheckMacro - sub to check if macro exists & process'
  1322. ' $PAGE
  1323. '
  1324. '  NAME    -- CheckMacro
  1325. '
  1326. '  INPUTS  -- PARAMETER             MEANING
  1327. '             Strng$               STRING TO CHECK IF IS A MACRO
  1328. '             ZMacroDrvPath$       DRIVE/PATH WHERE MACROS ARE
  1329. '             ZMacroExtension$     EXTENSION WasOF MACROS
  1330. '             MACRO.OFF            FORCE NO MACRO TO BE Found
  1331. '
  1332. '  OUTPUTS -- MacroFound           WHETHER A MACRO WAS Found
  1333. '             Strng$               SUBSTITUTE FOR COMMANDS
  1334. '             ZCommPortStack$      REST OF MACRO
  1335. '                                  0 IF NOT Found
  1336. '
  1337. '  PURPOSE -- Macro file is checked for security (1st line).
  1338. '             2nd line is substituted for passed string
  1339. '             and parsed.  Remaining part of macro put into
  1340. '             stack to be executed.
  1341. '
  1342.      SUB CheckMacro (Strng$,MacroFound) STATIC
  1343.      MacroFound = ZFalse
  1344.      IF ZMacroExtension$ = "" OR INSTR(Strng$,".") > 0 THEN _
  1345.         EXIT SUB
  1346.      IF LEN(Strng$) < ZMacroMin THEN _
  1347.         ZMacroMin = 1 : _
  1348.         EXIT SUB
  1349.      IF LEN(Strng$) = 1 THEN _
  1350.         Temp$ = Strng$ : _
  1351.         CALL AllCaps (Temp$) : _
  1352.         IF INSTR(ZAllOpts$,Temp$) > 0 THEN _
  1353.            EXIT SUB
  1354.      CALL Macro (Strng$,MacroFound)
  1355.      END SUB
  1356. 1325 ' $SUBTITLE: 'Macro - check if macro exists & process'
  1357. ' $PAGE
  1358. '
  1359. '  NAME    -- Macro
  1360. '
  1361. '  INPUTS  -- PARAMETER             MEANING
  1362. '             Strng$           STRING TO CHECK IF IS A MACRO
  1363. '             ZMacroDrvPath$   DRIVE/PATH WHERE MACROS ARE
  1364. '             ZMacroExtension$ EXTENSION OF MACROS
  1365. '             MACRO.OFF        FORCE NO MACRO TO BE Found
  1366. '
  1367. '  OUTPUTS -- MacroFound       WHETHER A MACRO WAS Found
  1368. '             Strng$           SUBSTITUTE FOR COMMANDS
  1369. '             ZCommPortStack$  REST OF MACRO
  1370. '                              0 IF NOT Found
  1371. '
  1372. '  PURPOSE -- Executes a macro if found.  Does not check if macro
  1373. '             letter uses a command.
  1374.      SUB Macro (Strng$,MacroFound) STATIC
  1375.      MacroFound = ZFalse
  1376.      Temp$ = Strng$
  1377.      CALL BreakFileName (Temp$,ZWasDF$,Prefix$,WasX$,ZFalse)
  1378.      IF Temp$ = Prefix$ THEN _
  1379.         FilName$ = ZMacroDrvPath$ + Strng$ + ZMacroExtension$ _
  1380.      ELSE FilName$ = Strng$
  1381.      CALL BadFile (FilName$,ZWasA)
  1382.      IF ZWasA > 1 THEN _
  1383.         EXIT SUB
  1384.      CALL GRAPHICX (ZUserGraphicDefault$,FilName$,6)
  1385.      IF NOT ZOK THEN _
  1386.         EXIT SUB
  1387.      CALL ReadDir (6,1)
  1388.      IF ZErrCode > 0 THEN _
  1389.         EXIT SUB
  1390.      CALL CheckInt (ZOutTxt$)
  1391.      IF ZErrCode > 0 OR ZUserSecLevel < ZTestedIntValue THEN _
  1392.         EXIT SUB
  1393.      ZWasA = INSTR(ZOutTxt$,"/")
  1394.      IF ZWasA > 0 THEN _    ' Check macro contraint
  1395.         WasX$ = RIGHT$(ZOutTxt$,LEN(ZOutTxt$)-ZWasA) : _
  1396.         IF RIGHT$(WasX$,1) = "/" THEN _
  1397.            IF ZLastCommand$ <> LEFT$(WasX$,LEN(WasX$)-1) THEN _
  1398.               EXIT SUB _
  1399.            ELSE GOTO 1327 _
  1400.         ELSE IF LEFT$(ZLastCommand$,LEN(WasX$)) <> WasX$ THEN _
  1401.                 EXIT SUB
  1402. 1327 ZMacroActive = ZTrue
  1403.      MacroFound = ZTrue
  1404.      ZMacroEcho = ZTrue
  1405.      END SUB
  1406. 1330 ' $SUBTITLE: 'ViewHelp    - Processes requests for help'
  1407. ' $PAGE
  1408. '
  1409. '  NAME    -- ViewHelp
  1410. '
  1411. '  INPUTS  -- PARAMETER             MEANING
  1412. '            Section             ORDER OF 1ST COMMAND IN CURRENT
  1413. '                                Section
  1414. '            GRAPHICS.DEFAULT    WHAT GRAPHICS TYPE USER WANTS
  1415. '            HelpDefault$        HELP GET IF PRESS ENTER
  1416. '            ZHelpPath$
  1417. '            ZHelpExtension$
  1418. '            ZBegFile
  1419. '            ZBegMain
  1420. '            ZBegUtil
  1421. '            ZBegLibrary
  1422. '
  1423. '  OUTPUTS -- DISPLAYS HELP
  1424. '
  1425. '  PURPOSE -- The main help processor for RBBS.  Puts up the
  1426. '             optional menu.  Accepts help with individual commands.
  1427. '
  1428.      SUB ViewHelp (Section,GraphicDefault$,HelpDefault$) STATIC
  1429.      HelpMenu$ = ZHelpPath$ + _
  1430.                   "HELP" + _
  1431.                   ZHelpExtension$
  1432.      SotMenu = ZTrue
  1433.      IF ZWasQ > 1 THEN _
  1434.         ZAnsIndex = 2 : _
  1435.         ZLastIndex = ZWasQ: _
  1436.         FastHelp = ZTrue : _
  1437.         GOTO 1332
  1438. 1331 IF SotMenu THEN _
  1439.         ZFileName$ = HelpMenu$ : _
  1440.         GOSUB 1350 : _
  1441.         SotMenu = ZFalse
  1442.      ZAnsIndex = 1
  1443.      ZOutTxt$ = "Help with what Command (or TOPIC name)" + _
  1444.           ZPressEnterExpert$
  1445.      ZSubParm = 1
  1446.      CALL TGet
  1447.      IF ZSubParm = -1 THEN _
  1448.         EXIT SUB
  1449.      IF ZWasQ = 0 THEN _
  1450.         EXIT SUB
  1451.      ZLastIndex = ZWasQ
  1452. 1332 ZWasZ$ = ZUserIn$(ZAnsIndex)
  1453.      CALL AllCaps (ZWasZ$)
  1454.      IF ZWasZ$ = "?" THEN _
  1455.         ZWasZ$ = "H"
  1456.      CALL BadFile (ZWasZ$,BadFileNameIndex)
  1457.      ON BadFileNameIndex GOTO 1333,1340,1340
  1458. 1333 IF LEN(ZWasZ$) <> 1 THEN _
  1459.         GOTO 1335
  1460.      CALL SearchCmd (Section,ZFF)
  1461.      IF ZFF < 1 THEN _
  1462.         ZOK = ZFalse : _
  1463.         GOTO 1336
  1464.      IF ZFF > LEN(ZAllOpts$) - 11 THEN _
  1465.         IF ZFF > LEN(ZAllOpts$) - 7 AND NOT ZSysop THEN _
  1466.            ZOK = ZFalse : _
  1467.            GOTO 1336 _
  1468.         ELSE ZWasZ$ = MID$(ZOrigCommands$,ZFF,1) : _
  1469.              GOTO 1335 _
  1470.      ELSE WasX = - (ZFF => ZBegMain) - (ZFF => ZBegFile) - (ZFF => ZBegUtil) - (ZFF => ZBegLibrary) : _
  1471.           ZWasZ$ = MID$("MFU@",WasX,1) + _
  1472.                    MID$(ZOrigCommands$,ZFF,1)
  1473. 1335 ZFileName$ = ZHelpPath$ + _
  1474.                   ZWasZ$ + _
  1475.                   ZHelpExtension$
  1476.      GOSUB 1350
  1477. 1336 IF NOT ZOK THEN _
  1478.         ZOutTxt$ = "No help for " + _
  1479.              ZWasZ$ : _
  1480.         CALL QuickTPut1 (ZOutTxt$) : _
  1481.         CALL UpdtCalr (ZOutTxt$,2)
  1482.      ZAnsIndex = ZAnsIndex + 1
  1483.      IF ZAnsIndex <= ZLastIndex THEN _
  1484.         GOTO 1332
  1485.      IF FastHelp THEN _
  1486.         FastHelp = ZFalse : _
  1487.         EXIT SUB
  1488.      GOTO 1331
  1489. 1340 ZOK = ZFalse
  1490.      GOTO 1336
  1491. 1350 CALL Graphic (GraphicDefault$,ZFileName$)
  1492.      CALL BufFile (ZFileName$,WasX)
  1493.      RETURN
  1494.      END SUB
  1495. 1380 ' $SUBTITLE: 'VIOLATION - handles all security violations'
  1496. ' $PAGE
  1497. '
  1498. '  NAME    -- SecViolation
  1499. '
  1500. '  INPUTS  --     PARAMETER                    MEANING
  1501. '
  1502. '  OUTPUTS -- ZCursorLine               CURRENT LINE ON SCREEN
  1503. '             ZCursorRow                CURRENT ROW ON ZCursorLine
  1504. '
  1505. '  PURPOSE -- Inform caller of security violation, augment count of
  1506. '             violations and determine whether too many occurred.
  1507. '
  1508.      SUB SecViolation STATIC
  1509.      CALL FlushKeys
  1510.      CALL BufFile (ZSecVioHelp$,WasX)
  1511.      IF NOT ZOK THEN _
  1512.         CALL QuickTPut1 ("Sorry, " + ZFirstName$ + ", action not permitted")
  1513.      CALL UpdtCalr ("SV!-" + ZViolation$,2)
  1514.      ZLastIndex = 0
  1515.      CALL Muzak (3)
  1516.      ZViolationsThisSession = ZViolationsThisSession + 1
  1517.      IF ZMaxViolations = 0 OR ZViolationsThisSession <= ZMaxViolations THEN _
  1518.         EXIT SUB
  1519. 1385 IF ZUserFileIndex < 1 THEN _
  1520.         EXIT SUB
  1521.      ZOutTxt$ = "SECURITY VIOLATION!  Sysop can reinstate"
  1522.      IF ZUserSecLevel <= ZMinLogonSec THEN _
  1523.         ZOutTxt$ = "" : _
  1524.         ZUserSecLevel = ZUserSecLevel - 1 _
  1525.      ELSE ZUserSecLevel = ZMinLogonSec
  1526.      ZDenyAccess = ZTrue
  1527.      END SUB
  1528. 1386 ' $SUBTITLE: 'DenyAccess - sub to permanently deny access'
  1529. ' $PAGE
  1530. '
  1531. '  NAME    -- DenyAccess
  1532. '
  1533. '  INPUTS  --     PARAMETER                    MEANING
  1534. '
  1535. '  OUTPUTS -- (USER'S RECORD)
  1536. '
  1537. '  PURPOSE -- Permanently resets user's security level when access denied
  1538. '
  1539.      SUB DenyAccess STATIC
  1540.      CALL TPut
  1541.      ZLogonErrorIndex = 5
  1542.      ZSubParm = 6
  1543.      CALL FileLock
  1544.      CALL OpenUser (HighestUserRecord)
  1545.      FIELD 5, 128 AS ZUserRecord$
  1546.      GET 5,ZUserFileIndex
  1547.      MID$(ZUserRecord$,47,2) = MKI$(ZUserSecLevel)
  1548.      PUT 5,ZUserFileIndex
  1549.      ZSubParm = 8
  1550.      CALL FileLock
  1551.      END SUB
  1552. 1396 ' $SUBTITLE: 'TPut -- common routine to write to comm. port'
  1553. ' $PAGE
  1554. '
  1555. '  NAME    -- TPut (TERMINAL PUT)
  1556. '
  1557. '  INPUTS  --     PARAMETER                    MEANING
  1558. '                     ZOutTxt$                 STRING TO WRITE TO THE
  1559. '                                              COMMUNICATIONS PORT
  1560. '                 ZSubParm = 1           SKIP A LINE BEFORE WRITING
  1561. '                                        TO THE COMMUNICATIONS PORT
  1562. '                          = 2           SKIP A LINE BEFORE WRITING
  1563. '                                        TO THE COMMUNICATIONS PORT
  1564. '                                        AND THEN SKIP TWO LINES
  1565. '                                        AFTER WRITING TO THE COMM-
  1566. '                                        UNICATIONS PORT
  1567. '                           = 3          WRITE TO THE COMMUNICATIONS
  1568. '                                        PORT AND THEN SKIP TWO LINES
  1569. '                           = 4          WRITE TO THE COMMUNICATIONS
  1570. '                                        PORT WITHOUT A CR/LF
  1571. '                           = 5          WRITE TO THE COMMUNICATIONS
  1572. '                                        PORT WITH A CR/LF
  1573. '                           = 6          RESET EVERYTHING FOR INPUT STRING
  1574. '                           = 7          RE-ENTRY AFTER HANDLING A
  1575. '                                        FUNCTION KEY
  1576. '
  1577. '  OUTPUTS --  ZSubParm = -1 Carrier HAS BEEN DROPPED
  1578. '              ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1579. '
  1580. '  PURPOSE --  Common output routine for RBBS-PC to the
  1581. '              communications port (terminal put)
  1582.       SUB TPut STATIC
  1583.       IF ZSubParm <> 7 THEN _
  1584.          Parm = ZSubParm
  1585.       ON ZSubParm GOTO 1398,1399,1400,1403,1405,1450,1411
  1586. '
  1587. '
  1588. ' *  COMMON OUTPUT ROUTINE
  1589. '
  1590. '
  1591. 1398 CALL SkipLine (1)
  1592.      GOTO 1405
  1593. 1399 CALL SkipLine (1)
  1594. 1400 ZCR = 1
  1595. 1403 ZCR = ZCR + 1
  1596. 1405 ZRet = ZFalse
  1597.      IF ZWasCM THEN _
  1598.         GOTO 1435
  1599. 1410 CALL FindFKey
  1600.      IF ZSubParm < 0 THEN _
  1601.         EXIT SUB
  1602. 1411 ZWasY$ = ZKeyPressed$
  1603.      ZSubParm = Parm
  1604.      IF ZLocalUser THEN _
  1605.         GOTO 1430
  1606.      CALL EofComm (Char)
  1607.      IF Char = -1 THEN _
  1608.         CALL CheckCarrier : _
  1609.         IF ZSubParm = -1 THEN _
  1610.            EXIT SUB _
  1611.         ELSE GOTO 1430
  1612.      CALL GetCom(ZWasY$)
  1613. 1425 IF ZSubParm = -1 THEN _
  1614.         EXIT SUB
  1615. 1430 IF ZWasY$ = "" THEN _
  1616.         GOTO 1435
  1617.      ON INSTR(ZInterrupOn$,ZWasY$) GOTO 1434,1434,1473,1475,1433
  1618.      GOSUB 1476
  1619.      GOTO 1435
  1620. 1433 GOSUB 1476
  1621.      IF ASC(RIGHT$(ZCommPortStack$,2)) = 13 OR _
  1622.         ZStopInterrupts THEN _
  1623.         GOTO 1435  'stack if series of [ENTER]s or no previous stack
  1624.      GOTO 1471
  1625. 1434 IF ZStopInterrupts THEN _
  1626.         GOTO 1435
  1627.      ZCommPortStack$ = ""
  1628.      IF ZFossil THEN _
  1629.         CALL FOSTXPurge(ZComPort) : _
  1630.         CALL FosRXPurge(ZComPort)
  1631.      GOTO 1471
  1632. 1435 LOCATE ,,1
  1633.      CALL LPrnt (ZOutTxt$,0)
  1634. 1437 IF ZUpperCase THEN _
  1635.         IF ZWasGR <> 2 THEN _
  1636.            CALL AllCaps (ZOutTxt$)
  1637.      CALL PutCom (ZOutTxt$)
  1638. 1450 IF ZCR <> 1 THEN _
  1639.         CALL SkipLine (1) _
  1640.      ELSE IF ZCR > 1 THEN _
  1641.              CALL SkipLine (1)
  1642. 1470 ZCR = 0
  1643.      EXIT SUB
  1644. 1471 CALL SkipLine (1)
  1645.      ZStopInterrupts = ZFalse
  1646.      ZRet = ZTrue
  1647.      ZNo = ZTrue
  1648.      ZNonStop = ZFalse
  1649.      GOTO 1470
  1650. 1473 ZXOffEd = ZTrue
  1651.      GOTO 1410
  1652. 1475 ZXOffEd = ZFalse
  1653.      GOTO 1410
  1654. 1476 IF ASC(ZWasY$) < 127 THEN _
  1655.         ZCommPortStack$ = ZCommPortStack$ + ZWasY$
  1656.      RETURN
  1657.      END SUB
  1658. 1478 ' $SUBTITLE: 'QuickTPut - subroutine to quickly write to terminal'
  1659. ' $PAGE
  1660. '
  1661. '  NAME    -- QuickTPut
  1662. '
  1663. '  INPUTS  -- PARAMETER             MEANING
  1664. '             Strng$             STRING TO WRITE OUT
  1665. '             NumReturns         NUMBER OF CARRIAGE RETURNS
  1666. '
  1667. '  OUTPUTS -- NONE
  1668. '
  1669. '  PURPOSE -- Subroutine to quickly write to the terminal.  This is
  1670. '             different from "TPut" in the things it doesn't do:
  1671. '                A.) No function key check,
  1672. '                B.) No conversion to upper case,
  1673. '                C.) No check for carrier present
  1674. '                D.) No check for imbedded carriage return in "Strng$"
  1675. '                E.) No support for XON/XOff
  1676. '
  1677.       SUB QuickTPut (Strng$,NumReturns) STATIC
  1678.       IF ZSubParm < 0 THEN _
  1679.          EXIT SUB
  1680.       IF ZUseTPut THEN _
  1681.          ZOutTxt$ = Strng$ : _
  1682.          ZSubParm = 4 : _
  1683.          CALL TPut : _
  1684.          CALL SkipLine (NumReturns) : _
  1685.          EXIT SUB
  1686.       CALL PutCom (Strng$)
  1687.       LOCATE ,,1
  1688.       CALL LPrnt (Strng$,0)
  1689.       CALL SkipLine (NumReturns)
  1690.       END SUB
  1691.       SUB QuickTPut1 (Strng$) STATIC
  1692.       CALL QuickTPut (Strng$,1)
  1693.       END SUB
  1694. 1480 ' $SUBTITLE: 'LPrnt    - subroutine to write to display'
  1695. ' $PAGE
  1696. '
  1697. '  NAME    -- LPrnt
  1698. '
  1699. '  INPUTS  -- PARAMETER             MEANING
  1700. '             Strng$        STRING TO WRITE OUT
  1701. '             NumReturns   NUMBER OF CARRIAGE RETURNS
  1702. '
  1703. '  OUTPUTS -- NONE
  1704. '
  1705. '  PURPOSE -- Subroutine to write to the display.
  1706. '
  1707.       SUB LPrnt (Strng$,NumReturns) STATIC
  1708.       IF NOT ZSnoop THEN _
  1709.          EXIT SUB
  1710.       CALL PScrn (Strng$)
  1711.       IF ZVoiceType <> 0 AND ZTalkAll THEN _
  1712.          CALL Talk (65,Strng$)
  1713.       IF ZUseBASICWrites THEN _
  1714.          FOR WasI = 1 TO NumReturns : _
  1715.             PRINT : _
  1716.          NEXT : _
  1717.       ELSE FOR WasI = 1 TO NumReturns : _
  1718.               LOCATE ,,1 : _
  1719.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1720.               LOCATE ZWasCL,ZWasCC : _
  1721.               NEXT
  1722.       END SUB
  1723. 1482 ' $SUBTITLE: 'QuickLPrnt - subroutine to quickly write to display'
  1724. ' $PAGE
  1725. '
  1726. '  NAME    -- QuickLPrnt
  1727. '
  1728. '  INPUTS  -- PARAMETER             MEANING
  1729. '             Strng$        STRING TO WRITE OUT
  1730. '             Num           NUMBER OF CARRIAGE RETURNS
  1731. '
  1732. '  OUTPUTS -- NONE
  1733. '
  1734. '  PURPOSE -- Subroutine to quickly write to the display.
  1735. '             Overwrites, and puts up count
  1736.       SUB QuickLPrnt (Strng$,Num) STATIC
  1737.       IF ZSnoop THEN _
  1738.          LOCATE ,1,1 : _
  1739.          CALL Pscrn (Strng$ + STR$(Num))
  1740.       END SUB
  1741. 1483 ' $SUBTITLE: 'PScrn    - subroutine to print to the screen'
  1742. ' $PAGE
  1743. '
  1744. '  NAME    -- PScrn
  1745. '
  1746. '  INPUTS  -- PARAMETER             MEANING
  1747. '             Strng$        STRING TO WRITE OUT
  1748. '
  1749. '  OUTPUTS -- NONE
  1750. '
  1751. '  PURPOSE -- Writes to local screen regardless of whether you have
  1752. '             carrier.  Assumes have positioned cursor where you want.
  1753. '
  1754.       SUB PScrn (Strng$) STATIC
  1755.       IF Strng$ = "" THEN _
  1756.          EXIT SUB
  1757.       IF ZUseBASICWrites THEN _
  1758.          PRINT Strng$; _
  1759.       ELSE CALL ANSI (Strng$,ZWasCL,ZWasCC) : _
  1760.            LOCATE ZWasCL,ZWasCC
  1761.       END SUB
  1762. 1485 ' $SUBTITLE: 'SkipLine - sub to write a blank line to user'
  1763. ' $PAGE
  1764. '
  1765. '  NAME    -- SkipLine
  1766. '
  1767. '  INPUTS  --   PARAMETER             MEANING
  1768. '               ZLocalUser
  1769. '               ZModemStatusReg
  1770. '               NumReturns
  1771. '               ZReturnLineFeed$
  1772. '               ZSnoop
  1773. '
  1774. '  OUTPUTS -- NONE
  1775. '
  1776. '  PURPOSE -- Skip lines on the user's terminal
  1777. '
  1778.       SUB SkipLine (NumReturns) STATIC
  1779.       FOR WasI=1 TO NumReturns
  1780.           CALL PutCom (ZReturnLineFeed$)
  1781.       NEXT
  1782.       IF NOT ZSnoop THEN _
  1783.          GOTO 1486
  1784.       IF ZUseBASICWrites THEN _
  1785.          FOR WasI = 1 TO NumReturns : _
  1786.             PRINT : _
  1787.          NEXT _
  1788.       ELSE FOR WasI = 1 TO NumReturns : _
  1789.               LOCATE ,,1 : _
  1790.               CALL ANSI(ZCrLf$,ZWasCL,ZWasCC) : _
  1791.               LOCATE ZWasCL,ZWasCC : _
  1792.            NEXT
  1793. 1486  ZLinesPrinted = ZLinesPrinted + NumReturns
  1794.       ZUnitCount = ZUnitCount - ZDisplayAsUnit * NumReturns
  1795.       END SUB
  1796. 1496 ' $SUBTITLE: 'SetCrLf -- sub to set up nulls/lf's for output'
  1797. ' $PAGE
  1798. '
  1799. '  NAME    -- SetCrLf
  1800. '
  1801. '  INPUTS  --   PARAMETER          MEANING
  1802. '              ZCarriageReturn$    CARRIAGE RETURN CHARACTER
  1803. '              ZLineFeed$          LINE FEED CHARACTER
  1804. '              ZLineFeeds          LINE FEED Switch
  1805. '              ZNul$                NULL CHARACTER
  1806. '
  1807. '  OUTPUTS -- ZReturnLineFeed$   END-OF-LINE STRING
  1808. '
  1809. '  PURPOSE -- Set up the necessary nulls/line feeds to end
  1810. '             each output to the communications port with.
  1811. '
  1812.       SUB SetCrLf STATIC
  1813.       ZReturnLineFeed$ = _
  1814.          MID$(ZCarriageReturn$,1, - (NOT ZLocalUser)) + _
  1815.          ZNul$ + _
  1816.          MID$(ZLineFeed$,1, - (ZLineFeeds <> 0))
  1817.       END SUB
  1818. 1498 ' $SUBTITLE: 'TGet -- ask a user a question and get reply'
  1819. ' $PAGE
  1820. '
  1821. '  NAME    -- TGet
  1822. '
  1823. '  INPUTS  --    PARAMETER                   MEANING
  1824. '                ZSubParm          = 1  STANDARD ENTRY
  1825. '                                  = 2  ENTRY AFTER A FUNCTION KEY
  1826. '                                         HAS BEEN HANDLED
  1827. '                                  = 3  ENTRY AFTER STACKED COMMAND
  1828. '             ZOutTxt$                        STRING TO WRITE TO THE
  1829. '                                       COMMUNICATIONS PORT
  1830. '             ZHidden                    IF THIS IS TRUE THEN ECHO
  1831. '                                       '.' INSTEAD OF ACTUAL
  1832. '                                       CHARACTER ENTERED.
  1833. '             ZForceKeyboard            IF TRUE, STACKED INPUT
  1834. '                                       IS BYPASSED AND KEYBOARD
  1835. '                                       INPUT IS READ.
  1836. '
  1837. '  OUTPUTS -- ZSubParm = -1 Carrier HAS BEEN DROPPED
  1838. '             ZUserIn$                  STRING THAT WAS ENTERED
  1839. '             ZWasQ                     NUMBER OF PARAMETERES THAT
  1840. '                                       WERE ENTERED WHICH WHERE
  1841. '                                       SEPARATED BY A SEMICOLON
  1842. '             ZUserIn$()                STRING MATRIX WITH EACH
  1843. '                                       ITEM CONTAIN THE STRING
  1844. '                                       THAT WAS ENTERED BETWEEN
  1845. '                                       SEMICOLONS.
  1846. '             ZFunctionKey        <>  0 FUNCTION KEY PRESSED
  1847. '             ZYes                      Reply IS "Y" OR "YES"
  1848. '             ZNo                       Reply IS "N" OR "NO"
  1849. '             ZNonStop                  Reply IS "NS" OR "ns"
  1850. '             ZKillMessage              Reply IS "K"
  1851. '             ZReply                    Reply IS "RE"
  1852. '
  1853. '  SUBROUTINE PURPOSE --  COMMON ROUTINE TO ASK A USER A QUESTION
  1854. '
  1855.      SUB TGet STATIC
  1856.      MacroIndex = ZForceKeyboard
  1857.      ON ZSubParm GOTO 1500,1538,1625
  1858. '
  1859. '
  1860. ' *  COMMON INPUT ROUTINE
  1861. '
  1862. '
  1863. 1500 CALL Carrier
  1864.      IF ZSubParm = -1 THEN _
  1865.         EXIT SUB
  1866.      ZLinesPrinted = 0
  1867.      ZDisplayAsUnit = ZFalse
  1868.      InStack = ZFalse
  1869.      GOSUB 1580
  1870.      ZWasA = 0
  1871.      ZWasB = 0
  1872.      ZWasC = 0
  1873.      ZWasQ = 1
  1874.      ZStoreParseAt = 1
  1875.      Parm = 0
  1876.      ZYes = ZFalse
  1877.      ZUserIn$ = ""
  1878.      SleepWarn = ZTrue
  1879.      ZNo = ZFalse
  1880.      ZNonStop = (ZPageLength < 1)
  1881.      IF ZOutTxt$ = "" THEN _
  1882.         GOTO 1525
  1883.      IF ZHidden THEN _
  1884.         ZOutTxt$ = ZOutTxt$ + " (dots echo)"
  1885.      IF (NOT ZVerifying) OR HoldA$ = "" THEN _
  1886.         CALL ColorPrompt (ZOutTxt$) : _
  1887.         ZOutTxt$ = ZOutTxt$ + _
  1888.              MID$("? !  ",2*ZTurboKey+1,2) : _
  1889.         HoldA$ = ZOutTxt$ _
  1890.      ELSE ZOutTxt$ = HoldA$
  1891.      ZSubParm = 4
  1892.      StopSave = ZStopInterrupts
  1893.      ZStopInterrupts = ZTrue
  1894.      CALL TPut
  1895.      ZStopInterrupts = StopSave
  1896.      IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  1897.         EXIT SUB
  1898. 1523 IF ZPromptBell THEN _
  1899.         IF ZLocalUser THEN _
  1900.            BEEP_
  1901.         ELSE CALL PutCom(ZBellRinger$)
  1902. 1525 CALL Carrier
  1903.      IF ZSubParm = -1 THEN _
  1904.         EXIT SUB
  1905.      IF LEN(ZCommPortStack$) > 0 THEN _
  1906.         InStack = ZTrue : _
  1907.         WasX = INSTR(ZCommPortStack$,ZCarriageReturn$) : _
  1908.         IF WasX > 0 THEN _
  1909.            ZOutTxt$ = LEFT$(ZCommPortStack$,WasX-1) : _
  1910.            ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-WasX) : _
  1911.            GOTO 1534 _
  1912.         ELSE ZWasY$ = LEFT$(ZCommPortStack$,1) : _
  1913.              ZCommPortStack$ = RIGHT$(ZCommPortStack$,LEN(ZCommPortStack$)-1) : _
  1914.              GOTO 1541
  1915.      IF (ZForceKeyboard OR (NOT ZMacroActive) OR (ZMacroSave > 0)) THEN _
  1916.         GOTO 1536
  1917. '
  1918. ' *** MACRO PROCESSING
  1919. '
  1920. 1526 CALL ReadMacro
  1921.      IF ZMacroSave > 0 THEN _
  1922.         GOTO 1500
  1923.      IF NOT ZMacroActive THEN _
  1924.         ZWasQ = 0 : _
  1925.         ZLastIndex = 0 : _
  1926.         EXIT SUB
  1927.      IF (ZDistantTGet > 0 ) OR (ZMacroTemplate$ <> "") THEN _
  1928.         GOTO 1536
  1929. 1534 ZUserIn$ = ZOutTxt$   ' Not Macro command - pass to normal processing
  1930.      IF ZMacroEcho THEN _
  1931.         ZSubParm = 4 : _
  1932.         CALL TPut
  1933.      WasX$ = ZCarriageReturn$
  1934.      GOTO 1547
  1935. 1536 IF ZLocalUser THEN _
  1936.         GOTO 1537
  1937.      '  CALL FindFKey: _
  1938.      '  IF ZSubParm < 0 THEN _
  1939.      '     EXIT SUB _
  1940.      '  ELSE GOTO 1538
  1941.      CALL EofComm (Char)
  1942.      IF Char <> -1 THEN _
  1943.         CALL GetCom(ZWasY$) : _
  1944.         IF ZSubParm = -1 THEN _
  1945.            EXIT SUB _
  1946.         ELSE GOTO 1541
  1947. 1537 CALL CheckTime(ZAutoLogoff!, TempElapsed!, 3)
  1948.      IF TempElapsed! < 30 THEN _
  1949.         IF TempElapsed! <= 0 THEN _
  1950.            CALL UpdtCalr ("Sleep disconnect",1) : _
  1951.            ZSubParm = -1 : _
  1952.            ZNo = ZTrue : _
  1953.            ZSleepDisconnect = ZTrue : _
  1954.            EXIT SUB _
  1955.         ELSE IF SleepWarn THEN _
  1956.                 SleepWarn = ZFalse : _
  1957.                 ZOutTxt$ = "LOGGING you OFF if you do not respond in 30 seconds!" : _
  1958.                 CALL RingCaller
  1959.      CALL FindFKey
  1960.      IF ZSubParm < 0 THEN _
  1961.         EXIT SUB
  1962. 1538 ZWasY$ = ZKeyPressed$
  1963.      IF ZWasY$ <> "" THEN _
  1964.         GOTO 1545
  1965.      SendRemote = ZTrue
  1966.      CALL GoIdle
  1967.      GOTO 1525
  1968. 1541 SendRemote = ZRemoteEcho
  1969.      IF ZTestParity THEN _
  1970.         GOTO 1542
  1971.      IF ZWasY$ = CHR$(127) THEN _
  1972.         GOTO 1635
  1973.      GOTO 1545
  1974. 1542 IF ZWasY$ = "" THEN _
  1975.         ZWasY$ = " "
  1976.      IF ASC(ZWasY$) = 141 THEN _
  1977.         OUT ZLineCntlReg,&H1A : _
  1978.         ZEightBit = ZFalse : _
  1979.         ZTestParity = ZFalse : _
  1980.         ZWasGR = ZFalse
  1981.      ZWasY$ = CHR$(ASC(ZWasY$) AND 127)
  1982. 1545 WasX$ = ZWasY$
  1983.      IF INSTR(ZLineEditChk$,ZWasY$) > 5 _
  1984.         GOTO 1635
  1985.      IF ZWasY$ < " " AND ZWasY$ <> ZCarriageReturn$ THEN _
  1986.         GOTO 1525
  1987.      IF ZWasY$ = "^" THEN _
  1988.         GOTO 1525
  1989.      IF ZWasY$ = ZCarriageReturn$ THEN _
  1990.         GOTO 1547 _
  1991.      ELSE GOSUB 1550
  1992.      IF ZTurboKey < 1 THEN _
  1993.         GOTO 1546
  1994.      IF ZWasY$ = " " THEN _
  1995.         ZWasY$ = ""
  1996.      IF ZWasY$ <> "/" THEN _
  1997.         ZUserIn$ = ZWasY$ : _
  1998.         ZWasY$ = ZCarriageReturn$ : _
  1999.         WasX$ = ZWasY$ : _
  2000.         GOTO 1547
  2001.      ZTurboKey = 0
  2002.      GOTO 1525
  2003. 1546 IF LEN(ZUserIn$) => 512 THEN _
  2004.         ZOutTxt$ = "Input too long!" : _
  2005.         ZSubParm = 5 : _
  2006.         CALL TPut : _
  2007.         IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  2008.            EXIT SUB _
  2009.         ELSE GOTO 1500
  2010.      ZUserIn$ = ZUserIn$ + _
  2011.           ZWasY$
  2012.      GOTO 1525
  2013. 1547 ZTurboKey = ZFalse          ' Carriage Return Handler
  2014.      ZHidden = ZFalse
  2015.      IF ZNoAdvance THEN _
  2016.         ZNoAdvance = ZFalse : _
  2017.         GOTO 1575 _
  2018.      ELSE CALL LPrnt (ZCrLf$,0) : _
  2019.           GOSUB 1551 : _
  2020.           GOTO 1570
  2021. 1550 IF ZLogonActive THEN _
  2022.         IF (ZWasY$ = " " OR ZWasY$ = ";") AND _
  2023.            RIGHT$(ZUserIn$,1) <> " " AND RIGHT$(ZUserIn$,1) <> ";" THEN _
  2024.               Parm = Parm + 1 : _
  2025.               ZLogonActive = (Parm < 3) : _
  2026.               ZHidden = (Parm = 2) : _
  2027.               CALL LPrnt(WasX$,0) : _
  2028.               GOTO 1551
  2029.      IF ZHidden AND (WasX$ <> " ") THEN _
  2030.         WasX$ = "."
  2031.      CALL LPrnt(WasX$,0)
  2032. 1551 IF NOT SendRemote THEN _
  2033.         RETURN
  2034.      IF ZHidden AND (WasX$ <> " ") THEN _
  2035.         WasX$ = "."
  2036. 1553 CALL PutCom (WasX$)
  2037.      RETURN
  2038. 1570 IF SendRemote THEN _
  2039.         IF ZLineFeeds THEN _
  2040.            CALL PutCom (ZLineFeed$)
  2041. 1575 IF LEN(ZUserIn$) > 4000 THEN _
  2042.         ZOutTxt$ = "Try again, " + _
  2043.              ZFirstName$ : _
  2044.         ZSubParm = 5 : _
  2045.         CALL TPut : _
  2046.         IF ZSubParm = -1 OR ZFunctionKey <> 0 THEN _
  2047.            EXIT SUB _
  2048.         ELSE GOTO 1500
  2049.      IF ZParseOff THEN _
  2050.         ZParseOff = ZFalse : _
  2051.         GOTO 1620
  2052.      CALL ParseIt
  2053.      IF ZWasQ = 1 THEN _
  2054.         GOTO 1622
  2055.      GOTO 1625
  2056. 1580 ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2057.      RETURN
  2058. 1620 ZUserIn$(ZStoreParseAt) = ZUserIn$
  2059.      ZWasQ = 1
  2060. 1622 IF ZUserIn$ = "" THEN _
  2061.         ZWasQ = 0 : _
  2062.         ZHidden = ZFalse : _
  2063.         GOTO 1628
  2064. 1625 IF LEN(ZUserIn$) < 4 THEN _
  2065.         WasX$ = LEFT$(ZUserIn$,3): _
  2066.         CALL AllCaps (WasX$) : _
  2067.         IF WasX$ = "Y" OR WasX$ = "YES" THEN _
  2068.            ZYes = ZTrue _
  2069.         ELSE IF WasX$ = "N" OR WasX$ = "NO" OR WasX$ = "A" THEN _
  2070.                 ZNo = ZTrue _
  2071.              ELSE IF WasX$ = "RE" THEN _
  2072.                      ZReply = ZTrue : _
  2073.                      GOTO 1628 _
  2074.                   ELSE IF WasX$ = "K" THEN _
  2075.                           ZKillMessage = ZTrue : _
  2076.                           GOTO 1628
  2077.      ZHidden = ZFalse
  2078. 1628 CALL VerifyAns
  2079.      IF NOT ZOK THEN _
  2080.         CALL QuickTPut1 ("Invalid answer <" + ZUserIn$(1) + ">") : _
  2081.         GOTO 1500
  2082.      HoldA$ = ""
  2083.      ZForceKeyboard = ZFalse
  2084.      IF ZMacroSave > 0 THEN _
  2085.         ZGSRAra$(ZMacroSave) = ZUserIn$ : _
  2086.         ZMacroSave = 0 : _
  2087.         GOTO 1632
  2088.      IF (ZDistantTGet > 0) OR (ZMacroTemplate$ <> "") THEN _
  2089.         CALL WipeLine (38) : _
  2090.         IF NOT ZNo THEN _
  2091.            GOTO 1632 _
  2092.         ELSE ZWasQ = 0 : _
  2093.              ZMacroTemplate$ = "" : _
  2094.              ZDistantTGet = 0 : _
  2095.              ZNo = ZFalse : _
  2096.              GOTO 1633
  2097.      IF ZMacroActive THEN _
  2098.         ZLastIndex = ZWasQ : _
  2099.         FirstIndex = 1: _
  2100.         EXIT SUB
  2101.      IF ZAnsIndex > 255 OR ((NOT InStack) AND INSTR(ZUserIn$,".") > 0) THEN _
  2102.         EXIT SUB
  2103.      IF MacroIndex THEN _
  2104.         MacroIndex = 1 _
  2105.      ELSE MacroIndex = ZAnsIndex
  2106.      CALL NoPath (ZUserIn$(MacroIndex),Found)
  2107.      IF Found THEN _
  2108.         EXIT SUB
  2109.      CALL CheckMacro (ZUserIn$(MacroIndex),Found)
  2110.      IF Found THEN _
  2111.         ZStoreParseAt = ZAnsIndex : _
  2112.         GOTO 1525
  2113.      EXIT SUB
  2114. 1632 ZUserIn$ = ""
  2115.      ZForceKeyboard = ZFalse
  2116. 1633 GOSUB 1580
  2117.      ZWasQ = 1
  2118.      GOTO 1525
  2119. 1635 IF LEN(ZUserIn$) = 0 THEN _
  2120.         GOTO 1525
  2121.      IF ZLogonActive THEN _
  2122.         IF INSTR(" ;",RIGHT$(ZUserIn$,1)) > 0 THEN _
  2123.            Parm = Parm - 1
  2124.      ZUserIn$ = LEFT$(ZUserIn$,LEN(ZUserIn$)-1)
  2125.      CALL LPrnt(ZLocalBksp$,0)
  2126.      IF SendRemote THEN _
  2127.         CALL PutCom(ZBackSpace$)
  2128.      GOTO 1525
  2129.      END SUB
  2130. 1636 ' $SUBTITLE: 'RingCaller - sub to use sound + screen emphasis'
  2131. ' $PAGE
  2132. '
  2133. '  NAME    -- RingCaller
  2134. '
  2135. '  INPUTS  --     PARAMETER                    MEANING
  2136. '                 ZOutTxt$                           STRING TO EMPHASIZE
  2137. '
  2138. '  OUTPUTS --  none
  2139. '
  2140. '  PURPOSE --  Rings the users bell before and after string
  2141. '              (but not snooping sysop) and adds emphasis around
  2142. '              message sent.
  2143. '
  2144.      SUB RingCaller STATIC
  2145.      WasX$ = LEFT$(ZBellRinger$,-ZLocalUser)
  2146.      CALL PutCom (ZBellRinger$)
  2147.      CALL LPrnt (WasX$,0)
  2148.      ZSubParm = 2
  2149.      ZOutTxt$ = ZEmphasizeOn$ + ZOutTxt$ + ZEmphasizeOff$
  2150.      CALL TPut
  2151.      CALL PutCom (ZBellRinger$)
  2152.      CALL LPrnt (WasX$,0)
  2153.      END SUB
  2154. 1637 ' $SUBTITLE: 'ParseIt - subroutine to parse a string'
  2155. ' $PAGE
  2156. '
  2157. '  NAME    -- ParseIt
  2158. '
  2159. '  INPUTS  --     PARAMETER                    MEANING
  2160. '                 ZUserIn$                     STRING TO PARSE
  2161. '
  2162. '  OUTPUTS --  ZWasQ                           NUMBER PARSED
  2163. '              ZUserIn$()                      PARSED STRINGS
  2164. '
  2165. '  PURPOSE --  To parse a string into pieces.  Uses semicolon
  2166. '              if exists, otherwise space, otherwise comma
  2167. '
  2168.      SUB ParseIt STATIC
  2169.      ZWasA = INSTR(ZUserIn$,";")
  2170.      IF ZWasA > 0 THEN _
  2171.         ParseChar$ = ";" _
  2172.      ELSE IF ZUserIn$ <> SPACE$(LEN(ZUserIn$)) THEN _
  2173.              CALL Trim (ZUserIn$) : _
  2174.              WasX$ = ZUserIn$ : _
  2175.              ZWasA = INSTR(ZUserIn$,"  ") : _
  2176.              WHILE ZWasA > 0 : _
  2177.                 ZUserIn$ = LEFT$(ZUserIn$,ZWasA - 1) + _
  2178.                      MID$(ZUserIn$,ZWasA + 1) : _
  2179.                 ZWasA = INSTR(ZWasA,ZUserIn$,"  ") : _
  2180.              WEND : _
  2181.              ZWasA = INSTR(ZUserIn$," ") : _
  2182.              IF ZWasA > 1 THEN _
  2183.                 ParseChar$ = " " _
  2184.              ELSE ZWasA = INSTR(ZUserIn$,",") : _
  2185.                   ParseChar$ = ","
  2186.      IF ZWasA > 1 THEN _
  2187.         GOTO 1639
  2188.      ZWasDF$ = ZUserIn$
  2189.      CALL AllCaps (ZWasDF$)
  2190.      IF ZWasDF$ = "NS" THEN _
  2191.          ZUserIn$ = "C" : _
  2192.          ZNonStop = ZTrue
  2193.      ZUserIn$(ZStoreParseAt) = ZUserIn$
  2194.      ZNonStop = ZNonStop OR (ZWasDF$ = "C" AND NOT ZStackC)
  2195.      GOTO 1642
  2196. 1639 ZUserIn$(ZStoreParseAt) = LEFT$(ZUserIn$,ZWasA - 1)
  2197.      ZWasA = ZWasA + 1
  2198.      ZEOL = ZFalse
  2199. 1640 ZWasB = INSTR(ZWasA,ZUserIn$,ParseChar$)
  2200.      ZWasC = ZWasB-ZWasA
  2201.      IF ZWasC < 1 THEN _
  2202.         ZEOL = ZTrue : _
  2203.         ZWasC = 128
  2204.      ZWasDF$ = MID$(ZUserIn$,ZWasA,ZWasC)
  2205.      IF ZWasDF$ <> "" THEN _
  2206.         ZWasQ = ZWasQ + 1 : _
  2207.         ZStoreParseAt = ZStoreParseAt + 1 : _
  2208.         ZUserIn$(ZStoreParseAt) = ZWasDF$ : _
  2209.         CALL AllCaps(ZWasDF$) : _
  2210.         WasX = INSTR(";NS;/G;C;",";"+ZWasDF$+";") : _
  2211.         IF WasX > 0 THEN _
  2212.            ZNonStop = ZNonStop OR (WasX = 1) OR (WasX = 7 AND NOT ZStackC) : _
  2213.            ZAutoLogoffReq = ZAutoLogoffReq OR (WasX = 4) : _
  2214.            IF ZWasQ > 0 AND WasX < 7 THEN _
  2215.               ZWasQ = ZWasQ - 1 : _
  2216.               ZStoreParseAt = ZStoreParseAt - 1
  2217.      IF NOT ZEOL AND ZWasQ < 50 THEN _
  2218.         ZWasA = ZWasB + 1 : _
  2219.         GOTO 1640
  2220.      IF ParseChar$ <> ";" THEN _
  2221.         ZUserIn$ = WasX$
  2222. 1642 ZStackC = ZFalse
  2223.      END SUB
  2224. 1650 ' $SUBTITLE: 'PopCmdStack - prompt for value with command stack check'
  2225.      SUB PopCmdStack STATIC
  2226.      CALL CheckCarrier
  2227.      IF ZSubParm = -1 THEN _
  2228.         ZLastIndex = 0 : _
  2229.         ZWasQ = 0 : _
  2230.         EXIT SUB
  2231.      ZWasQ = 1
  2232. 1651 IF ZAnsIndex < ZLastIndex THEN _
  2233.         ZAnsIndex = ZAnsIndex + 1 : _
  2234.         ZUserIn$ = ZUserIn$(ZAnsIndex) : _
  2235.         IF (NOT ZStackC) AND ZAnsIndex > 1 AND INSTR("Cc",ZUserIn$) > 0 AND LEN(ZUserIn$) = 1 THEN _
  2236.            GOTO 1651 _
  2237.         ELSE ZSubParm = 3 : _
  2238.              CALL TGet : _
  2239.              GOTO 1652
  2240.      ZLastIndex = 0
  2241.      ZAnsIndex = 1
  2242.      ZSubParm = 1
  2243.      ZSearchingAll = ZFalse
  2244.      CALL TGet
  2245.      ZLastIndex = ZWasQ
  2246. 1652 IF ZStoreParseAt > ZLastIndex THEN _
  2247.         IF ZLastIndex > 0 THEN _
  2248.            ZLastIndex = ZStoreParseAt
  2249.      ZStackC = ZFalse
  2250.      ZParseOff = ZFalse
  2251.      END SUB
  2252. 1654 ' $SUBTITLE: 'SetBaud - sub to set the baud rate in the RS232'
  2253. ' $PAGE
  2254. '
  2255. '  NAME    -- SetBaud
  2256. '
  2257. '  INPUTS  --     PARAMETER                    MEANING
  2258. '             ZBaudRateDivisor   NUMBER TO DIVIDE THE 8250 CHIP'S
  2259. '                                 PROGRAMABLE CLOCK TO ADJUST THE
  2260. '                                 BAUD RATE TO THE USER'S BAUD
  2261. '                                 RATE (INDEPENDENT OF THE BAUD
  2262. '                                 RATE USED TO OPEN THE COMM. PORT)
  2263. '
  2264. '        DESIRED BAUD        DIVISIOR (DECIMAL) TO OBTAIN DESIRED BAUD RATE
  2265. '            RATE              PCjr         PC AND XT
  2266. '              50             2237             2304
  2267. '              75             1491             1536
  2268. '             110             1017             1047
  2269. '             134.5            832              857
  2270. '             150              746              768
  2271. '             300              373              384
  2272. '             600              186              192
  2273. '            1200               93               96
  2274. '            1800               62               64
  2275. '            2000               56               58
  2276. '            2400               47               48
  2277. '            3600               31               32
  2278. '            4800               23               24
  2279. '            7200          not available         16
  2280. '            9600          not available         12
  2281. '           19200          not available          6
  2282. '           38400               "                 3
  2283. '  OUTPUTS -- BAUD RATE SET IN THE RS232 INTERFACE
  2284. '
  2285. '  PURPOSE -- To set the baud rate in the RS232 interface
  2286. '             inpependent of the baud rate the communications port
  2287. '             was opened at
  2288. '
  2289.       SUB SetBaud STATIC
  2290.      IF NOT ZKeepInitBaud THEN _
  2291.         ZTalkToModemAt$ =  MID$(ZBaudRates$,(-5 * ZBPS),5) _
  2292.      ELSE ZTalkToModemAt$ = ZModemInitBaud$
  2293.      CALL Trim (ZTalkToModemAt$)
  2294.      IF LEN(ZTalkToModemAt$) < 5 THEN _
  2295.         ZTalkToModemAt$ = SPACE$(4 - LEN(ZTalkToModemAt$)) + _
  2296.                             ZTalkToModemAt$
  2297.      IF ZEightBit THEN_
  2298.         Parity = 2 : _                                    ' No PARITY
  2299.         DataBits = 3 : _                                  ' 8 DATA BITS
  2300.         StopBits = 0 _                                    ' 1 STOP BIT
  2301.      ELSE Parity = 3 : _                                  ' EVEN PARITY
  2302.           DataBits = 2 : _                                ' 7 DATA BITS
  2303.           StopBits = 0                                    ' 1 STOP BIT
  2304.      ComSpeed! = VAL(ZTalkToModemAt$)
  2305.      IF ComSpeed! > 19200 THEN _
  2306.         IF FOSSIL THEN _
  2307.            WasI = &H9600 _
  2308.         ELSE WasI = 19200 _
  2309.      ELSE WasI = ComSpeed!
  2310.      IF ZFossil THEN _
  2311.         CALL FosSpeed(ZComPort,WasI,Parity,DataBits,StopBits) : _
  2312.         EXIT SUB
  2313.      IF ComSpeed! = 2400 THEN _
  2314.         ZBaudRateDivisor = &H30 + (1 * (ZComputerType = 2)) _
  2315.      ELSE IF ComSpeed! = 1200 THEN _
  2316.         ZBaudRateDivisor = &H60 + (3 * (ZComputerType = 2)) _
  2317.      ELSE IF ComSpeed! = 9600 THEN _
  2318.         ZBaudRateDivisor = &HC _
  2319.      ELSE IF ComSpeed! = 300 THEN _
  2320.         ZBaudRateDivisor = &H180 + (11 * (ZComputerType = 2)) _
  2321.      ELSE IF ComSpeed! = 450 THEN _
  2322.         ZBaudRateDivisor = &H100 + (8 * (ZComputerType = 2)) _
  2323.      ELSE IF ComSpeed! = 4800 THEN _
  2324.         ZBaudRateDivisor = &H18 _
  2325.      ELSE IF ComSpeed! = 19200 THEN _
  2326.         ZBaudRateDivisor = &H6 _
  2327.      ELSE IF ComSpeed! = 38400 THEN _
  2328.         ZBaudRateDivisor = &H3
  2329.      MostSignifByte = FIX (ZBaudRateDivisor / 256)
  2330.      LeastSignifByte = ZBaudRateDivisor - (MostSignifByte * 256)
  2331.      LineCntlStatus = INP(ZLineCntlReg)
  2332.      MSBSave = INP(ZMSB)
  2333.      OUT ZMSB,0
  2334.      OUT ZLineCntlReg,LineCntlStatus OR 128
  2335.      OUT ZLSB,LeastSignifByte
  2336.      OUT ZMSB,MostSignifByte
  2337.      OUT ZLineCntlReg,LineCntlStatus
  2338.      OUT ZMSB,MSBSave
  2339.      END SUB
  2340. 2018 ' $SUBTITLE: 'MessageTo - subroutine to get who a message is to'
  2341. ' $PAGE
  2342. '
  2343. '  NAME    -- MessageTo
  2344. '
  2345. '  INPUTS  --     PARAMETER                    MEANING
  2346. '              HighestUserRecord
  2347. '
  2348. '  OUTPUTS --  MsgTo$              Who message is to
  2349. '              RcvrRecNum         User record # of who to
  2350. '
  2351. '  PURPOSE --  Asks who a message is to and determines if receiver exists
  2352. '
  2353.      SUB MessageTo (HighestUserRecord,MsgTo$,MsgFrom$,RcvrRecNum,Found) STATIC
  2354.      Temp$ = MsgFrom$
  2355.      CALL Trim (Temp$)
  2356. 2020 IF MsgTo$ <> "" THEN _
  2357.         GOTO 2032
  2358.      ZOutTxt$ = "To [A]ll,S)ysop, or name"
  2359.      CALL SkipLine (1)
  2360.      ZParseOff = ZTrue
  2361.      GOSUB 2033
  2362.      IF LEN(ZUserIn$) > 30 THEN _
  2363.         CALL QuickTPut1 ("30 Char. Max") : _
  2364.         GOTO 2020
  2365. 2030 Found = ZTrue
  2366.      RcvrRecNum = 0
  2367.      IF ZWasQ = 0 THEN _
  2368.         MsgTo$ = "ALL" _
  2369.      ELSE CALL AllCaps (ZUserIn$) : _
  2370.           IF ZUserIn$ = "A" THEN _
  2371.              MsgTo$ = "ALL" : _
  2372.              EXIT SUB _
  2373.           ELSE IF ZUserIn$ = "S" THEN _
  2374.              MsgTo$ = "SYSOP" _
  2375.           ELSE MsgTo$ = ZUserIn$
  2376. 2032 IF MsgTo$ <> "ALL" THEN _
  2377.         IF (LEFT$(MsgTo$,4) <> "ALL " AND ZStartHash = 1) THEN _
  2378.            TempHashValue$ = MsgTo$ : _
  2379.            CALL WhoCheck (TempHashValue$,Found,RcvrRecNum) : _
  2380.            IF NOT Found THEN _
  2381.               ZLastIndex = 0 : _
  2382.               IF NOT ZReply THEN _
  2383.                  ZOutTxt$ = "[R]e-enter name, Q)uit, C)ontinue" : _
  2384.                  ZTurboKey = -ZTurboKeyUser : _
  2385.                  ZLastIndex = 0 : _
  2386.                  GOSUB 2033 : _
  2387.                  ZWasZ$ = ZUserIn$(1) : _
  2388.                  CALL AllCaps (ZWasZ$) : _
  2389.                  IF ZWasZ$ <> "C" THEN _
  2390.                     MsgTo$ = "" : _
  2391.                     IF ZWasZ$ <> "Q" THEN _
  2392.                        GOTO 2020
  2393.      IF MsgTo$ = Temp$ THEN _
  2394.         ZOutTxt$ = "Msg would be from and to SAME PERSON!  Really do this (Y,[N])" : _
  2395.         ZLastIndex = 0 : _
  2396.         GOSUB 2033 : _
  2397.         IF NOT ZYes THEN _
  2398.            MsgTo$ = ""
  2399.      EXIT SUB
  2400. 2033 CALL PopCmdStack
  2401.      IF ZSubParm < 0 THEN _
  2402.         EXIT SUB
  2403.      RETURN
  2404.      END SUB
  2405. 2055 ' $SUBTITLE: 'MsgProt - gets protection wanted for a message'
  2406. ' $PAGE
  2407. '
  2408. '  NAME    -- MsgProt
  2409. '
  2410. '  INPUTS  --     PARAMETER                    MEANING
  2411. '                 MsgTo$
  2412. '                 Found
  2413. '
  2414. '  OUTPUTS --  ZPswd$                Protection desired
  2415. '
  2416. '  PURPOSE --  Sets protection desired for a new message
  2417. '
  2418.      SUB MsgProt (MsgTo$,Found,MsgPswd$) STATIC
  2419.      IF MsgTo$ = "ALL" THEN _
  2420.         GOTO 2090
  2421. 2060 ZOutTxt$ = "Make message p(U)blic, p(R)ivate, (P)assword protected, (H)elp"
  2422.      IF MsgPswd$ = "^READ^" THEN _
  2423.         DefaultProt$ = "R" : _
  2424.         GOTO 2065
  2425.      IF LEFT$(MsgPswd$,1) = "!" THEN _
  2426.         DefaultProt$ = "P" _
  2427.      ELSE _
  2428.         DefaultProt$ = "U"
  2429. 2065 MID$(ZOutTxt$,INSTR(ZOutTxt$,"("+DefaultProt$+")"),3) = "["+DefaultProt$+"]"
  2430.      ZTurboKey = -ZTurboKeyUser
  2431.      GOSUB 2096
  2432.      IF ZWasQ = 0 THEN _
  2433.         ZUserIn$(ZAnsIndex) = DefaultProt$
  2434.      ZWasZ$ = LEFT$(ZUserIn$(ZAnsIndex),1)
  2435.      CALL AllCaps (ZWasZ$)
  2436.      ON INSTR("RUPH",ZWasZ$) GOTO 2075,2090,2075,2070
  2437.      GOTO 2060
  2438. '
  2439. ' **  DISPLAY MESSAGE PROTECT HELP   *
  2440. '
  2441. 2070 CALL BufFile (ZHelp$(3),WasX)
  2442.      GOTO 2060
  2443. '
  2444. ' ** MAKE MESSAGE READ PROTECTED (ONLY ADDRESSEE AND SYSOP CAN READ IT) *
  2445. '
  2446. 2075 IF MsgTo$ = "ALL" THEN _
  2447.         CALL QuickTPut1 ("Msg to ALL cannot be private") : _
  2448.         GOTO 2060
  2449.      IF ZWasZ$ = "P" THEN _
  2450.         GOTO 2088
  2451. 2081 CALL QuickTPut1 ("Sending personal mail to " + MsgTo$)
  2452. 2084 MsgPswd$ = "^READ^"
  2453.      EXIT SUB
  2454. 2085 ZOutTxt$ = "Password"
  2455.      GOSUB 2096
  2456.      IF ZWasQ = 0 THEN _
  2457.         IF LEFT$(MsgPswd$,1) = "!" THEN _
  2458.            MsgPswd$ = MID$(MsgPswd$,2) : _
  2459.            CALL QuickTPut1 ("Password is " + MsgPswd$) : _
  2460.            RETURN _
  2461.         ELSE _
  2462.         GOTO 2085
  2463.      IF LEN(ZUserIn$) > WasL THEN _
  2464.         CALL QuickTPut1 (STR$(WasL) + " Chars. max") : _
  2465.         GOTO 2085
  2466.      IF WasL = 15 AND LEFT$(ZUserIn$,1) = "!" THEN _
  2467.         CALL QuickTPut1 ("Password can't begin with '!'") : _
  2468.         GOTO 2085
  2469.      RETURN
  2470. '
  2471. ' **  PASSWORD PROTECT MESSAGE (USERS WITH PASSWORD AND SYSOP CAN READ) *
  2472. '
  2473. 2088 ZOutTxt$ = "Receiver(s) Must KNOW PASSWORD TO READ msg.  Use password (Y/[N])"
  2474.      GOSUB 2093
  2475.      IF NOT ZYes THEN _
  2476.         GOTO 2070
  2477.      WasL = 14
  2478.      WasA1$ = "!"
  2479.      GOSUB 2085
  2480.      CALL AllCaps (ZUserIn$)
  2481.      GOTO 2092
  2482. '
  2483. ' ** MAKE MESSAGE KILL PROTECTED (ONLY SENDER, ADDRESSEE AND SYSOP CAN KILL) *
  2484. '
  2485. 2090 WasL = 15
  2486.      WasA1$ = ""
  2487.      ZUserIn$ = "^KILL^"
  2488. 2092 MsgPswd$ = WasA1$ + _
  2489.                          ZUserIn$
  2490.      EXIT SUB
  2491. 2093 ZTurboKey = -ZTurboKeyUser
  2492. 2094 ZSubParm = 1
  2493.      CALL TGet
  2494. 2095 IF ZSubParm = -1 THEN _
  2495.         EXIT SUB
  2496.      RETURN
  2497. 2096 CALL PopCmdStack
  2498.      GOTO 2095
  2499.      END SUB
  2500. 2250 ' $SUBTITLE: 'WhoCheck - Checks whether user exists'
  2501. ' $PAGE
  2502. '
  2503. '  NAME    -- WhoCheck
  2504. '
  2505. '  INPUTS  --   PARAMETER                    MEANING
  2506. '              WhoFind$                User to find
  2507. '
  2508. '  OUTPUTS --  WhoFound                Whether user found
  2509. '              UserNumFound           Record # of user
  2510. '
  2511. '  PURPOSE --  Validate that user record exists.  Sysop
  2512. '              counted as found even if lack user record.
  2513. '
  2514.      SUB WhoCheck (WhoFind$,WhoFound,UserNumFound) STATIC
  2515.      UserNumFound = 0
  2516.      IF ZStartHash <> 1 THEN _
  2517.         WhoFound = ZTrue : _
  2518.         EXIT SUB
  2519.      Work128$ = ZUserRecord$
  2520.      WhoFound = ZFalse
  2521.      ToSysop = (INSTR(WhoFind$,"SYSOP") > 0 OR _
  2522.                  INSTR(WhoFind$,ZSysopPswd1$ + " " + ZSysopPswd2$) > 0 )
  2523.      CALL OpenUser (HighestUserRecord)
  2524.      FIELD 5, 128 AS ZUserRecord$
  2525.      IF ToSysop THEN _
  2526.         WasX$ = ZSysopPswd1$ + " " + ZSysopPswd2$ _
  2527.      ELSE WasX$ = WhoFind$
  2528.      IF LEN(WasX$) > 1 THEN _
  2529.         CALL FindUser (WasX$,"",ZStartHash,ZLenHash,_
  2530.                        0,0,HighestUserRecord,WhoFound,_
  2531.                        UserNumFound,ZWasSL)
  2532.      LSET ZUserRecord$ = Work128$
  2533.      IF NOT WhoFound THEN _
  2534.         IF ToSysop THEN _
  2535.            WhoFound = ZTrue _
  2536.         ELSE CALL QuickTPut1 (WhoFind$ + " not active user")
  2537.      END SUB
  2538. 2618 ' $SUBTITLE: 'EditALine - Edits a line in a message'
  2539. ' $PAGE
  2540. '
  2541. '  NAME    -- EditALine
  2542. '
  2543. '  INPUTS  --     PARAMETER                    MEANING
  2544. '                 WasL                        Line # to edit
  2545. '
  2546. '  OUTPUTS --  ZOutTxt$(WasL)                 Edited line
  2547. '
  2548. '  PURPOSE --  Edit a line in a message.
  2549. '
  2550.      SUB EditALine (WasL) STATIC
  2551. 2620 ZOutTxt$ = "Line #" + _
  2552.           STR$(WasL) + _
  2553.           " is:" + _
  2554.           ZReturnLineFeed$ + _
  2555.           ZOutTxt$(WasL)
  2556.      ZSubParm = 3
  2557.      CALL TPut
  2558.      GOSUB 2695
  2559.      IF NOT ZExpertUser THEN _
  2560.         CALL QuickTPut1 ("Search & replace")
  2561.      ZOutTxt$ = "Search for" + _
  2562.           ZPressEnterExpert$
  2563.      ZMacroMin = 99
  2564.      ZParseOff = ZTrue
  2565.      ZSubParm = 1
  2566.      GOSUB 2694
  2567.      IF ZWasQ = 0 THEN _
  2568.         EXIT SUB
  2569.      ZWasY$ = LEFT$(ZUserIn$,1)
  2570.      IF ZWasY$ = RIGHT$(ZUserIn$,1) THEN _
  2571.         IF LEN(ZUserIn$) > 2 THEN _
  2572.            WasX = INSTR(2,ZUserIn$,ZWasY$) : _
  2573.            IF WasX < LEN(ZUserIn$) THEN _
  2574.               IF ZWasY$ < "0" OR (ZWasY$ > "9" AND ZWasY$ < "A") THEN _
  2575.                  ZUserIn$ = MID$(ZUserIn$,2,LEN(ZUserIn$)-2) : _
  2576.                  WasX = WasX - 1 : _
  2577.                  GOTO 2622
  2578.      WasX = INSTR(ZUserIn$,";")
  2579. 2622 IF WasX > 0 THEN _
  2580.         WasX$ = LEFT$(ZUserIn$,WasX-1) : _
  2581.         ZWasY$ = RIGHT$(ZUserIn$,LEN(ZUserIn$)-WasX) : _
  2582.         GOTO 2660
  2583.      WasX$ = ZUserIn$
  2584.      ZOutTxt$ = "And replace by"
  2585.      ZParseOff = ZTrue
  2586.      ZSubParm = 1
  2587.      GOSUB 2694
  2588.      ZWasY$ = ZUserIn$
  2589. 2660 WasX = INSTR(1,ZOutTxt$(WasL),WasX$)
  2590.      IF WasX = 0 THEN _
  2591.         CALL QuickTPut1 ("<" + WasX$ + "> not found in line" + STR$(WasL)) : _
  2592.         GOTO 2620
  2593. 2670 ZFF = LEN(WasX$)
  2594.      WasJJ = LEN(ZWasY$)
  2595.      IF ZFF = WasJJ THEN _
  2596.         MID$(ZOutTxt$(WasL),WasX) = ZWasY$ : _
  2597.         GOTO 2620
  2598. 2690 ZWasDF$ = LEFT$(ZOutTxt$(WasL),WasX - 1)
  2599.      ZOutTxt$(WasL) = ZWasDF$ + _
  2600.              ZWasY$ + _
  2601.              MID$(ZOutTxt$(WasL),WasX + ZFF)
  2602.      IF LEN(ZOutTxt$(WasL)) > ZRightMargin THEN _
  2603.         CALL WordWrap (ZRightMargin, ZLinesInMsg, ZOutTxt$())
  2604.      GOTO 2620
  2605. 2694 CALL TGet
  2606. 2695 IF ZSubParm > -1 THEN _
  2607.         RETURN
  2608.      END SUB
  2609.  
  2610. 3700 ' $SUBTITLE: 'LineEdit  - subroutine to produce edited line'
  2611. ' $PAGE
  2612. '
  2613. '  NAME    -- LineEdit
  2614. '
  2615. '  INPUTS  -- PARAMETER             MEANING
  2616. '             ZBackArrow$
  2617. '             ZBackSpace$
  2618. '             ZCarriageReturn$
  2619. '             ZLineFeed$
  2620. '             ZLineMes$          BUFFER SPACE TO USE FOR HOLDING LINE
  2621. '             ZLocalUser
  2622. '             MaxLen             MAXIMUM LENGTH OF STRING TO INPUT
  2623. '             MsgLine            WHERE IN ZOutTxt$() TO PUT THE EDITED LINE
  2624. '             ZRightMargin
  2625. '             ZSnoop
  2626. '             ZStopInterrupts
  2627. '             ZTabSize           TAB STOP EVERY x COLUMNS
  2628. '             ZWaitExpired
  2629. '
  2630. '  OUTPUTS -- ZOutTxt$(MsgLine)  EDITED LINE
  2631. '
  2632. '  PURPOSE -- Subroutine to edit a line quickly using a minimum of
  2633. '             string space.
  2634. '
  2635. ' -------------------------------------------------------------------------
  2636. ' Source has been totally rewriteen so as to be legible, and to support
  2637. ' both tabs and tab erasures.  This code has been written to conform
  2638. ' with MicroSoft QuickBASIC v4.5 specifications, and may not work with
  2639. ' QB 3.0 without modification.  Rewrite by Tim Gage 5/8/1990
  2640. ' -------------------------------------------------------------------------
  2641. ' 
  2642.    SUB LineEdit (MsgLine, MaxLen) STATIC
  2643.  
  2644.    ZWaitExpired = ZFalse
  2645.    ZStopInterrupts = ZTrue
  2646.    ZTabSize=5
  2647.    ZAutoLogoff!=TIMER+ZWaitBeforeDisconnect
  2648.   
  2649.    '
  2650.    ' Expand The String
  2651.    '
  2652.    j$ = ""
  2653.    FOR t = 1 TO LEN(ZOutTxt$(MsgLine))
  2654.       IF MID$(ZOutTxt$(MsgLine), t, 1) = CHR$(9) THEN
  2655.          q = ZTabSize - ((LEN(j$) - 1) MOD ZTabSize)
  2656.          IF q = 1 THEN
  2657.             j$ = j$ + CHR$(9)
  2658.          ELSE
  2659.             j$ = j$ + SPACE$(q - 1) + CHR$(9)
  2660.          END IF
  2661.       ELSE
  2662.          j$ = j$ + MID$(ZOutTxt$(MsgLine), t, 1)
  2663.       END IF
  2664.    NEXT
  2665.    LSET ZLineMes$ = j$
  2666.    Col = LEN(j$) + 1
  2667.  
  2668.  
  2669.    '
  2670.    ' Get Keyboard Stuff
  2671.    '
  2672.    DO
  2673.       call Carrier
  2674.       if ZSubParm = -1 then exit sub
  2675.       i$ = ""
  2676.       CALL FindFKey
  2677.       IF ZKeyPressed$ <> "" THEN
  2678.          i$ = ZKeyPressed$
  2679.       ELSEIF NOT ZLocalUser AND ZCommPortStack$ <> "" THEN
  2680.          i$ = LEFT$(ZCommPortStack$, 1)
  2681.          ZCommPortStack$ = RIGHT$(ZCommPortStack$, LEN(ZCommPortStack$) - 1)
  2682.       ELSEIF NOT ZLocalUser THEN
  2683.          CALL EofComm(Char)
  2684.          SendRemote = ZRemoteEcho
  2685.          IF Char <> -1 THEN
  2686.             ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2687.             CALL GetCom(i$)
  2688.          ELSE
  2689.             CALL CheckTime(ZAutoLogoff!, TempElapsed!, 1)
  2690.             IF TempElapsed! <= 0 THEN
  2691.                ZWaitExpired = ZTrue
  2692.                EXIT SUB
  2693.             END IF
  2694.             CALL Carrier
  2695.             IF ZSubParm = -1 THEN EXIT SUB
  2696.          END IF
  2697.       END IF
  2698.  
  2699.       IF i$ <> "" THEN
  2700.          SELECT CASE ASC(i$)
  2701.             CASE 13           ' Carriage Return
  2702.                '
  2703.                ' Accept Changes
  2704.                '
  2705.                IF SendRemote THEN CALL PutCom(CHR$(13))
  2706.                IF ZLocalUser OR ZSnoop THEN CALL LPrnt("", 1)
  2707.                IF SendRemote AND ZLineFeeds THEN
  2708.                   CALL PutCom(ZLineFeed$)
  2709.                END IF
  2710.                EXIT DO
  2711.             CASE 8            ' BackSpace
  2712.                IF Col > 1 THEN
  2713.                   '
  2714.                   ' Kill Tab
  2715.                   '
  2716.                   IF MID$(ZLineMes$, Col - 1, 1) = CHR$(9) THEN
  2717.                      q = 0
  2718.                      FOR t = Col - 1 TO (INT((Col - 2) / ZTabSize) * ZTabSize + 1) STEP -1
  2719.                         IF MID$(ZLineMes$, t, 1) <> " " AND MID$(ZLineMes$, t, 1) <> CHR$(9) THEN
  2720.                            EXIT FOR
  2721.                         END IF
  2722.                         IF SendRemote THEN CALL PutCom(CHR$(8)+" "+chr$(8))
  2723.                         IF ZLocalUser OR ZSnoop THEN CALL LPrnt(CHR$(8)+" "+chr$(8), 0)
  2724.                         q = q + 1
  2725.                      NEXT
  2726.                      Col = Col - q
  2727.                   '
  2728.                   ' Kill Normal Character
  2729.                   '
  2730.                   ELSE
  2731.                      IF SendRemote THEN CALL PutCom(CHR$(8)+" "+chr$(8))
  2732.                      IF ZLocalUser OR ZSnoop THEN CALL LPrnt(CHR$(8)+" "+chr$(8), 0)
  2733.                      Col = Col - 1
  2734.                   END IF
  2735.                END IF
  2736.             CASE 26           ' Ctl-Y
  2737.                '
  2738.                ' Kill Entire Line
  2739.                '
  2740.                FOR t = 1 TO Col - 1
  2741.                   IF SendRemote THEN CALL PutCom(CHR$(8)+" "+chr$(8))
  2742.                   IF ZLocalUser OR ZSnoop THEN CALL LPrnt(CHR$(8)+" "+chr$(8), 0)
  2743.                NEXT
  2744.                Col = 1
  2745.             CASE 27           ' Escape
  2746.                '
  2747.                ' Abort Edits
  2748.                '
  2749.                FOR t = 1 TO Col - 1  ' Delete Editted Line
  2750.                   IF SendRemote THEN CALL PutCom(CHR$(8))
  2751.                   IF ZLocalUser OR ZSnoop THEN CALL LPrnt(CHR$(8), 0)
  2752.                NEXT
  2753.                FOR t = 1 TO Col - 1  ' Delete Editted Line
  2754.                   IF SendRemote THEN CALL PutCom(" ")
  2755.                   IF ZLocalUser OR ZSnoop THEN CALL LPrnt(" ", 0)
  2756.                NEXT
  2757.                FOR t = 1 TO Col - 1  ' Delete Editted Line
  2758.                   IF SendRemote THEN CALL PutCom(CHR$(8))
  2759.                   IF ZLocalUser OR ZSnoop THEN CALL LPrnt(CHR$(8), 0)
  2760.                NEXT
  2761.                FOR t = 1 TO LEN(j$)  ' Paint Old Line
  2762.                   IF MID$(j$, t, 1) = CHR$(9) THEN
  2763.                      IF SendRemote THEN CALL PutCom(" ")
  2764.                      IF ZLocalUser OR ZSnoop THEN CALL LPrnt(" ", 0)
  2765.                   ELSE
  2766.                      IF SendRemote THEN CALL PutCom(MID$(j$, t, 1))
  2767.                      IF ZLocalUser OR ZSnoop THEN CALL LPrnt(MID$(j$, t, 1), 0)
  2768.                   END IF
  2769.                NEXT
  2770.                IF ZLocalUser OR ZSnoop THEN CALL LPrnt("", 1)
  2771.                IF SendRemote AND ZLineFeeds THEN CALL PutCom(ZLineFeed$)
  2772.                EXIT SUB
  2773.             CASE 9            ' Tab
  2774.                '
  2775.                ' Add Tab
  2776.                '
  2777.                IF Col < ((INT(MaxLen / ZTabSize) - 1) * ZTabSize) THEN
  2778.                   q = ZTabSize - ((Col - 1) MOD ZTabSize)
  2779.                   FOR t = 1 TO q - 1
  2780.                      MID$(ZLineMes$, Col + t - 1, 1) = " "
  2781.                      IF SendRemote THEN CALL PutCom(" ")
  2782.                      IF ZLocalUser OR ZSnoop THEN CALL LPrnt(" ", 0)
  2783.                   NEXT
  2784.                   MID$(ZLineMes$, Col + q - 1, 1) = CHR$(9)
  2785.                   IF SendRemote THEN CALL PutCom(" ")
  2786.                   IF ZLocalUser OR ZSnoop THEN CALL LPrnt(" ", 0)
  2787.                   Col = Col + q
  2788.                ELSE
  2789.                   CALL SkipLine(1)
  2790.                   EXIT DO
  2791.                END IF
  2792.                ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2793.             CASE IS < 32      ' Tripe Ignore It
  2794.             CASE ELSE
  2795.                '
  2796.                ' Insert Character
  2797.                '
  2798.                IF i$ = " " AND Col > MaxLen - 3 THEN
  2799.                   CALL SkipLine(1)
  2800.                   EXIT DO
  2801.                END IF
  2802.                MID$(ZLineMes$, Col, 1) = i$
  2803.                IF SendRemote THEN CALL PutCom(i$)
  2804.                IF ZLocalUser OR ZSnoop THEN CALL LPrnt(i$, 0)
  2805.                Col = Col + 1
  2806.                ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2807.          END SELECT
  2808.  
  2809.      if i$=" " and Col>=MaxLen-3 then
  2810.             call SkipLine(1)
  2811.             exit do
  2812.          endif
  2813.      if Col>=MaxLen then
  2814.             WasZ=Col-1
  2815.             do while mid$(ZLineMes$,WasZ,1)<>" " and mid$(ZLineMes$,WasZ,1)<>chr$(9) and WasZ>0
  2816.                WasZ=WasZ-1
  2817.             loop
  2818.             if WasZ=0 then exit do
  2819.             ZOutTxt$(MsgLine)=left$(ZLineMes$,WasZ-1)
  2820.             ZOutTxt$(MsgLine+1)=mid$(ZLineMes$,WasZ+1,Col-WasZ-1)
  2821.             for t=1 to Col-WasZ-1
  2822.                IF SendRemote THEN CALL PutCom(chr$(8)+" "+chr$(8))
  2823.                IF ZLocalUser OR ZSnoop THEN CALL LPrnt(chr$(8)+" "+chr$(8), 0)
  2824.             next
  2825.             call SkipLine(1)
  2826.             exit sub
  2827.          endif
  2828.          ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  2829.       END IF
  2830.    LOOP
  2831.    
  2832.    Col=Col-1
  2833.    if Col<=0 then
  2834.       ZOutTxt$(MsgLine) = ""  ' Return a null value
  2835.       exit sub
  2836.    endif
  2837.    '
  2838.    ' Pack The String
  2839.    '
  2840.    j$ = ""
  2841.    FOR t = Col TO 1 STEP -1
  2842.       j$ = MID$(ZLineMes$, t, 1) + j$
  2843.       IF MID$(ZLineMes$, t, 1) = CHR$(9) THEN
  2844.          '
  2845.          ' Shrink Expanded Tabs To A Single Tab (chr$(9))
  2846.          '
  2847.          q = 0
  2848.          FOR n = t TO (INT((t - 1) / ZTabSize) * ZTabSize + 1) STEP -1
  2849.             IF MID$(ZLineMes$, n, 1) <> " " AND MID$(ZLineMes$, n, 1) <> CHR$(9) THEN
  2850.                EXIT FOR
  2851.             END IF
  2852.             q = q + 1
  2853.          NEXT
  2854.          t = t - q + 1
  2855.       END IF
  2856.    NEXT
  2857.    ZOutTxt$(MsgLine) = j$  ' Return the editted value
  2858. END SUB
  2859.  
  2860.  
  2861. 3952 ' $SUBTITLE: 'KillMsg - subroutine to delete messages'
  2862. ' $PAGE
  2863. '
  2864. '  NAME    -- KillMsg
  2865. '
  2866. '  INPUTS  --     PARAMETER                    MEANING
  2867. '              MsgToKill                   MESSAGE NUMBER TO KILL
  2868. '              ActiveMessages              NUMBER ACTIVE MESSAGES
  2869. '
  2870. '  OUTPUTS --  NONE
  2871. '
  2872. '  PURPOSE --  To kill/delete old or unnecessary messages
  2873. '
  2874.      SUB KillMsg (MsgToKill,ActiveMessages) STATIC
  2875. '
  2876.      FIELD #1,128 AS ZMsgRec$
  2877.      WasQX = 1
  2878. 3955 IF WasQX > ActiveMessages THEN _
  2879.         ZOutTxt$ = "No such msg #" + _
  2880.              STR$(MsgToKill) : _
  2881.         GOTO 4031
  2882.      IF ZMsgPtr(WasQX,2) = MsgToKill AND MsgToKill => 1 THEN _
  2883.         GOTO 3970
  2884.      WasQX = WasQX + 1
  2885.      GOTO 3955
  2886. 3970 ZSubParm = 3
  2887.      CALL FileLock
  2888.      GET 1,ZMsgPtr(WasQX,1)
  2889.      IF ZUserSecLevel >= ZSecKillAny THEN _
  2890.         GOTO 4030
  2891. 3980 ZWasZ$ = MID$(ZMsgRec$,101,15)
  2892.      CALL Trim (ZWasZ$)
  2893.      IF LEN(ZWasZ$) = 0 THEN _
  2894.         GOTO 4030
  2895. 3990 IF ZWasZ$ = "^READ^" OR ZWasZ$ = "^KILL^" THEN _
  2896.         CALL MsgNameMatch (ZActiveUserName$,"",6,MsgFromCaller) : _
  2897.         CALL MsgNameMatch (ZActiveUserName$,"",37,MsgToCaller) : _
  2898.         IF (MsgFromCaller or MsgToCaller) THEN _
  2899.            GOTO 4030 _
  2900.         ELSE ZMsgPswd = ZTrue : _
  2901.              ZAttemptsAllowed = 0 : _
  2902.              ZOutTxt$ = "Only sender & receiver can kill" : _
  2903.              GOTO 4031
  2904. 4000 IF LEFT$(ZWasZ$,1) = "!" THEN _
  2905.         ZWasZ$ = MID$(ZWasZ$,2)
  2906. 4010 ZPswdSave$ = ZWasZ$ + _
  2907.                       SPACE$(15 - LEN(ZWasZ$))
  2908.      ZAttemptsAllowed = 1
  2909.      ZMsgPswd = ZTrue
  2910.      CALL PassWrd
  2911.      IF ZPswdFailed THEN _
  2912.         GOTO 4031
  2913. 4030 MID$(ZMsgRec$,116,1) = ZDeletedMsg$
  2914.      PUT 1,LOC(1)
  2915.      ZSubParm = 4
  2916.      CALL FileLock
  2917.      ZOutTxt$ = "Killed Msg # " + _
  2918.           STR$(MsgToKill)
  2919.      CALL UpdtCalr (ZOutTxt$,1)
  2920. 4031 ZSubParm = 5
  2921.      CALL TPut
  2922.      END SUB
  2923. 4554 ' $SUBTITLE: 'SetThread - Sets up the interface for threading'
  2924. ' $PAGE
  2925. '
  2926. '  NAME    -- SetThread
  2927. '
  2928. '  INPUTS  --     PARAMETER                    MEANING
  2929. '                 CurMsgNum                 Current message number
  2930. '                 CurSubj$                  Current message subject
  2931. '
  2932. '  OUTPUTS --  ZUserIn$()                   Search msg by string
  2933. '              ZWasQ                        0 if thread cancelled
  2934. '
  2935. '  PURPOSE --  Find out how the caller wants to thread -
  2936. '              i.e. search messages by matching subject -
  2937. '              forward from current, back from current,
  2938. '              or forward from top of messages
  2939. '
  2940.      SUB SetThread (CurMsgNum,CurSubj$) STATIC
  2941.      IF ZWasQ > 1 THEN _
  2942.         ZWasZ$ = ZUserIn$(2) : _
  2943.         GOTO 4657
  2944. 4656 ZOutTxt$ = "THREAD: +)forward, -)back, 1)from origin ([ENTER] quits)"
  2945.      ZTurboKey = -ZTurboKeyUser
  2946.      ZSubParm = 1
  2947.      CALL TGet
  2948.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  2949.         EXIT SUB
  2950.      ZWasZ$ = ZUserIn$(1)
  2951. 4657 ZWasZ$ = LEFT$(ZWasZ$,1)
  2952.      WasX = INSTR("+-1",ZWasZ$)
  2953.      IF WasX = 0 THEN _
  2954.         GOTO 4656
  2955.      ZUserIn$(1) = "R"
  2956.      IF WasX = 1 THEN _
  2957.         CurMsgNum = CurMsgNum + 1 _
  2958.      ELSE IF WasX = 2 THEN _
  2959.              CurMsgNum = CurMsgNum - 1 _
  2960.           ELSE CurMsgNum = 1 : _
  2961.                ZWasZ$ = "+"
  2962.      ZUserIn$(3) = MID$(STR$(CurMsgNum),2) + ZWasZ$
  2963.      IF LEN(CurSubj$) < 4 OR LEFT$(CurSubj$,3) <> "(R)" THEN _
  2964.         ZUserIn$(2) = CurSubj$ _
  2965.      ELSE ZUserIn$(2) = MID$(CurSubj$,4)
  2966.      ZUserIn$(2) = LEFT$(ZUserIn$(2) + "  ",22)
  2967.      ZLastIndex = 3
  2968.      ZAnsIndex = 1
  2969.      ZWasQ = 3
  2970.      END SUB
  2971. 4773 ' $SUBTITLE: 'SysopChat - chat with sysop'
  2972. ' $PAGE
  2973. '
  2974. '  NAME    -- SysopChat
  2975. '
  2976. '  INPUTS  --     PARAMETER                    MEANING
  2977. '  OUTPUTS --  ZWasCM                     True if chat active
  2978. '
  2979. '  PURPOSE --  Lets sysop chat interactively with caller
  2980. '
  2981.      SUB SysopChat STATIC
  2982.      ZWasCM = ZTrue
  2983.      TimeChatStarted! = TIMER
  2984.      ZSubParm = 1
  2985.      CALL Line25
  2986.      ZOutTxt$(2) = ""
  2987. 4775 CALL LineEdit (1,72)
  2988.      IF ZKeyPressed$ = ZEscape$ OR _
  2989.         ZSubParm < 0 THEN _
  2990.         GOTO 4777
  2991.      ZOutTxt$(1) = ""
  2992.      IF ZOutTxt$(2) <> "" THEN _
  2993.         ZOutTxt$ = ZOutTxt$(2) : _
  2994.         ZOutTxt$(1) = ZOutTxt$(2) : _
  2995.         ZOutTxt$(2) = "" _
  2996.      ELSE ZOutTxt$ = ""
  2997.      ZSubParm = 4
  2998.      CALL TPut
  2999.      IF ZSubParm > -1 THEN _
  3000.         GOTO 4775
  3001. 4777 ZWasCM = 0
  3002.      CALL CheckTime(TimeChatStarted!,Elapsed!, 2)
  3003.      ZSecsPerSession! = ZSecsPerSession! + Elapsed!
  3004.      IF NOT ZLocalUser THEN _
  3005.         ZAutoLogoff! = TIMER + ZWaitBeforeDisconnect
  3006.      CALL QuickTPut("  Chat ended.  Returning to normal operation",2)
  3007.      END SUB
  3008. 5100 ' $SUBTITLE: 'RemNonAlf - removes non-alpha chars from a string'
  3009. ' $PAGE
  3010. '
  3011. '  NAME    -- RemNonAlf
  3012. '
  3013. '  INPUTS  --     PARAMETER                    MEANING
  3014. '                 Strng$                   String to check
  3015. '                 MinChar                  Remove chars with this
  3016. '                                          ASCII value or lower
  3017. '                 MaxChar                  Remove chars with this
  3018. '                                          ASCII value or higher
  3019. '
  3020. '  OUTPUTS --       Strng$                 String returned
  3021. '  PURPOSE --  CALCULATE THE ELASPED TIME A USER HAS BEEN ON
  3022. '
  3023.      SUB RemNonAlf (Strng$,MinChar,MaxChar) STATIC
  3024.      Last = LEN(Strng$)
  3025.      WasJ = 1
  3026.      WHILE WasJ <= Last
  3027.         WasK = ASC(MID$(Strng$,WasJ))
  3028.         IF WasK > MinChar AND WasK < MaxChar THEN _
  3029.            WasJ = WasJ + 1 _
  3030.         ELSE Strng$ = LEFT$(Strng$,WasJ - 1) + _
  3031.                       RIGHT$(Strng$,Last - WasJ) : _
  3032.              Last = Last - 1
  3033.      WEND
  3034.      END SUB
  3035. 5200 ' $SUBTITLE: 'PageLen - Sets lines per page'
  3036. ' $PAGE
  3037. '
  3038. '  NAME    -- PageLen
  3039. '
  3040. '  INPUTS  --     PARAMETER                    MEANING
  3041. '               ZPageLength              Current page length
  3042. '
  3043. '  OUTPUTS --   ZPageLength              New page length
  3044. '
  3045. '  PURPOSE --  Change default lines per page
  3046. '
  3047.      SUB PageLen STATIC
  3048. 5202 ZOutTxt$ = "CHANGE page length from" + _
  3049.           STR$(ZPageLength) + _
  3050.           " TO (0-255, 0=continuous)"
  3051.      CALL PopCmdStack
  3052.      IF ZWasQ = 0 OR ZSubParm = -1 THEN _
  3053.         CALL QuickTPut1 ("No change") : _
  3054.         EXIT SUB
  3055. 5230 CALL CheckInt (ZUserIn$(ZAnsIndex))
  3056.      IF ZErrCode <> 0 THEN _
  3057.         GOTO 5202
  3058.      IF ZTestedIntValue < 0 OR _
  3059.         ZTestedIntValue > 255 THEN _
  3060.         GOTO 5202
  3061.      ZPageLength = ZTestedIntValue
  3062.      CALL QuickTPut1 ("Page Length Set to" + STR$(ZPageLength))
  3063.      END SUB
  3064. 5507 ' $SUBTITLE: 'Baud450 -- Changes 300 baud to 450'
  3065. ' $PAGE
  3066. '  NAME    -- Baud450
  3067. '
  3068. '  INPUTS  -- PARAMETER             MEANING
  3069. '             ZBPS
  3070. '
  3071. '  OUTPUTS -- ZBPS
  3072. '
  3073. '  PURPOSE -- Allow 300 baud modems to bump up to 450 baud
  3074. '
  3075.      SUB Baud450 STATIC
  3076.      IF ZBPS <> -1 THEN _
  3077.         CALL QuickTPut1 ("Sorry, only 300 baud can change speed") : _
  3078.         EXIT SUB
  3079.      IF ZFossil THEN _
  3080.         CALL QuickTPut1 ("Sorry, 450 baud NOT supported under FOSSIL") : _
  3081.         EXIT SUB
  3082.      ZOutTxt$ = "Change to 450 baud (Y,[N])"
  3083.      ZTurboKey = -ZTurboKeyUser
  3084.      ZSubParm = 1
  3085.      CALL TGet
  3086.      IF ZSubParm = -1 OR NOT ZYes THEN _
  3087.         EXIT SUB
  3088. 5510 CALL QuickTPut1 ("Change your baud rate to 450")
  3089.      CALL DelayTime (9)
  3090.      ZWasC = 0
  3091.      ZBPS = -2
  3092.      CALL SetBaud
  3093.      ZOutTxt$ = " and then press [ENTER] until I respond"
  3094.      ZSubParm = 9
  3095.      CALL TGet
  3096. 5530 ZWasC = ZWasC + 1
  3097.      CALL Carrier
  3098.      IF ZSubParm = -1 THEN _
  3099.         EXIT SUB
  3100.      IF ZWasC = 20 THEN _
  3101.         CALL UpdtCalr ("Baud change failed",1) : _
  3102.         ZBPS = -1 : _
  3103.         CALL SetBaud : _
  3104.         EXIT SUB
  3105.      CALL DelayTime (1)
  3106. 5535 CALL EofComm (Char)
  3107.      IF Char = -1 THEN _
  3108.         GOTO 5530
  3109. 5536 CALL PutCom(ZOutTxt$)
  3110.      IF ZOutTxt$ = "" THEN _
  3111.         ZOutTxt$ = " "
  3112.      IF ASC(ZOutTxt$) = 13 THEN _
  3113.         GOTO 5540
  3114.      IF ZSubParm = -1 THEN _
  3115.         EXIT SUB
  3116. 5537 GOTO 5530
  3117. 5540 ZOutTxt$ = "Changed to 450 baud"
  3118.      CALL QuickTPut1 (ZOutTxt$)
  3119.      CALL UpdtCalr (ZOutTxt$,1)
  3120.      ZBPS = -2
  3121.      ZOutTxt$ = ""
  3122.      END SUB
  3123. 9140 ' $SUBTITLE: 'GetTime - subroutine to calculate elapsed time'
  3124. ' $PAGE
  3125. '
  3126. '  NAME    -- GetTime
  3127. '
  3128. '  INPUTS  --     PARAMETER                    MEANING
  3129. '                ZTimeLoggedOn$
  3130. '
  3131. '  OUTPUTS --  ZSessionHour               NUMBER OF HOURS ON
  3132. '              ZSessionMin                NUMBER OF MINUTES ON
  3133. '              ZSessionSec                NUMBER OF SECONDS ON
  3134. '
  3135. '  PURPOSE --  Calculate the elapsed time a user has been on
  3136. '
  3137.      SUB GetTime STATIC
  3138.      CALL CheckTime(ZUserLogonTime!, TempElapsed!, 2)
  3139.      ZSessionHour = TempElapsed! / 3600
  3140.      ZSessionMin = (TempElapsed! - ZSessionHour * 3600!) / 60
  3141.      ZSessionSec = TempElapsed! - (ZSessionHour * 3600! + ZSessionMin * 60!)
  3142.      IF ZSessionSec < 0 THEN _
  3143.         ZSessionSec = ZSessionSec + 60 : _
  3144.         ZSessionMin = ZSessionMin - 1
  3145.      IF ZSessionMin < 0 THEN _
  3146.         ZSessionMin = ZSessionMin + 60 : _
  3147.         ZSessionHour = ZSessionHour - 1
  3148.      END SUB
  3149. 9600 ' $SUBTITLE: 'DefaultU - subroutine to update user defauts'
  3150. ' $PAGE
  3151. '
  3152. '  NAME    -- DefaultU
  3153. '
  3154. '  INPUTS  --     PARAMETER                    MEANING
  3155. '             ZAutoDownDesired
  3156. '             ZBoldText$              Ansi bold (0 no, 1 yes)
  3157. '             ZCheckBulletLogon
  3158. '             ZExpertUser
  3159. '             ZWasGR
  3160. '             ZLastMsgRead
  3161. '             ZLineFeeds
  3162. '             ZNulls
  3163. '             ZPageLength
  3164. '             ZPromptBell
  3165. '             ZRegDate$
  3166. '             ZReqQuesAnswered
  3167. '             ZRightMargin
  3168. '             ZSkipFilesLogon
  3169. '             ZTimesLoggedOn
  3170. '             ZUpperCase
  3171. '             ZUserOption$
  3172. '             ZUserTextColor          Ansi of color (31-37)
  3173. '             ZUserXferDefault$
  3174. '
  3175. '  OUTPUTS--  USER.OPTONS$
  3176. '
  3177. '  PURPOSE --  To update the user's record with their options.
  3178. '  Meaning of graphics preference stored is as follows: where # is
  3179. '  value stored for the color.  E.g. if graphics perference for text
  3180. '  files is color, and preference for normal text is light yellow,
  3181. '  graphics preference stored is 38.  Colors are Red, Green, Yellow,
  3182. '  Blue, Purple, Cyan, and White.
  3183. '
  3184. '             normal                  bold
  3185. ' Graphics R  G  Y  B  P  C  W    R  G  Y  B  P  C  W
  3186. '   none  30 33 36 39 42 45 48 | 51 54 57 60 63 66 69
  3187. '   ansi  31 34 37 40 43 46 49 | 52 55 58 61 64 67 70
  3188. '  color  32 35 38 41 44 47 50 | 53 56 59 62 65 68 71
  3189. '
  3190.      SUB DefaultU STATIC
  3191.      ZWasA =    -ZPromptBell          -2 * ZExpertUser _
  3192.             -4 * ZNulls               -8 * ZUpperCase _
  3193.            -16 * ZLineFeeds          -32 * ZCheckBulletLogon _
  3194.            -64 * ZSkipFilesLogon    -128 * ZAutoDownDesired _
  3195.           -256 * ZReqQuesAnswered   -512 * ZMailWaiting _
  3196.          -1024 * (NOT ZHiLiteOff)  -2048 * ZTurboKeyUser
  3197.      WasX = 3*ZUserTextColor - 63 + 21*VAL(ZBoldText$) + ZWasGR
  3198.      IF WasX < 1 OR WasX > 255 THEN _
  3199.         WasX = 48
  3200.      LSET ZUserOption$ = _
  3201.         MKI$(ZTimesLoggedOn) + _
  3202.         MKI$(ZLastMsgRead) + _
  3203.         ZUserXferDefault$ + _
  3204.         CHR$(WasX) + _
  3205.         MKI$(ZRightMargin) + _
  3206.         MKI$(ZWasA) + _
  3207.         ZRegDate$ + _
  3208.         CHR$(ZPageLength) + _
  3209.         ZEchoer$
  3210.      END SUB
  3211. 9801 ' $SUBTITLE: 'WhosOn - subroutine to display who is on'
  3212. ' $PAGE
  3213. '
  3214. '  NAME    -- WhosOn
  3215. '
  3216. '  INPUTS  --     PARAMETER                    MEANING
  3217. '                NumNodes                   # of nodes to check
  3218. '                ZActiveMessageFile$        Current message file
  3219. '                ZOrigMsgFile$              Main msg file
  3220. '
  3221. '  OUTPUTS --  None
  3222. '
  3223. '  PURPOSE --  To display who is on each node.
  3224. '
  3225.      SUB WhosOn (NumNodes) STATIC
  3226.      WasA1$ = ZActiveMessageFile$
  3227.      ZActiveMessageFile$ = ZOrigMsgFile$
  3228.      CALL OpenMsg
  3229.      FIELD 1, 128 AS ZMsgRec$
  3230.      FOR NodeIndex = 2 TO NumNodes + 1
  3231.         GET 1,NodeIndex
  3232.         ZOutTxt$ = ZFG1$ + "Node" + _
  3233.              STR$(NodeIndex - 1) + ZFG2$
  3234.         RecIndex = VAL(MID$(ZMsgRec$,44,2))
  3235.         IF RecIndex = 0 THEN _
  3236.            RecIndex = -1
  3237.         WasAX$ = MID$(ZBaudRates$,(-5 * RecIndex ),5) + _
  3238.               " BAUD: "
  3239.         IF MID$(ZMsgRec$,55,2) = "-1" AND NOT ZSysop THEN _
  3240.            ZWasY$ = "SYSOP" + SPACE$(21) _
  3241.         ELSE ZWasY$ = MID$(ZMsgRec$,1,26)
  3242.         WasAX$ = WasAX$ + ZFG3$ + ZWasY$
  3243.         IF MID$(ZMsgRec$,40,2) <> "-1" THEN _
  3244.            WasAX$ = WasAX$ + ZFG4$ + MID$(ZMsgRec$,93,22)
  3245.         IF MID$(ZMsgRec$,57,1) = "A" THEN _
  3246.            ZOutTxt$ = ZOutTxt$ + "  Online at " + _
  3247.                 WasAX$ _
  3248.         ELSE IF NOT ZSysop THEN _
  3249.                 ZOutTxt$ = ZOutTxt$ + _
  3250.                      " Waiting for next caller" _
  3251.              ELSE ZOutTxt$ = ZOutTxt$ + _
  3252.                        " Offline at " + _
  3253.                        WasAX$
  3254.         CALL QuickTPut1 (ZOutTxt$)
  3255.         CALL AskMore ("",ZTrue,ZTrue,ZAnsIndex,ZFalse)
  3256.         IF ZNo THEN _
  3257.            NodeIndex = NumNodes + 2
  3258.      NEXT
  3259.      ZActiveMessageFile$ = WasA1$
  3260.      CALL QuickTPut (ZEmphasizeOff$,0)
  3261.      END SUB
  3262. 10410 ' $SUBTITLE: 'RecoverMsg - sub to recover deleted messages'
  3263. ' $PAGE
  3264. '
  3265. '  NAME    -- RecoverMsg
  3266. '
  3267. '  INPUTS  --     PARAMETER                    MEANING
  3268. '               MsgToRecover          MESSAGE NUMBER TO RECOVER
  3269. '               FirstMsgRecord        RECORD # FOR First MSG
  3270. '
  3271. '  OUTPUTS --  ActionFlag                 SET TO 0 IF ERROR
  3272. '                                         SET TO -1 IF No ERROR
  3273. '
  3274. '  PURPOSE --  To recover deleted messages.  Note that this is only
  3275. '              possible if you have not compressed your message file
  3276. '              using config.
  3277. '
  3278.       SUB RecoverMsg (MsgToRecover,FirstMsgRecord,ActionFlag) STATIC
  3279.       FIELD #1,128 AS ZMsgRec$
  3280.       MsgRec = FirstMsgRecord
  3281. 10420 GET 1,MsgRec
  3282.       NumRecsInMsg = VAL(MID$(ZMsgRec$,117,4))
  3283.       IF NumRecsInMsg < 1 OR MsgRec => ZNextMsgRec THEN _
  3284.          ZWasY$ = "No Msg #" + _
  3285.               STR$(MsgToRecover) : _
  3286.          GOTO 10485
  3287. 10440 IF VAL(MID$(ZMsgRec$,2,4)) <> MsgToRecover THEN _
  3288.          MsgRec = MsgRec + NumRecsInMsg : _
  3289.          GOTO 10420
  3290. 10450 IF INSTR(ZMsgRec$,ZDeletedMsg$) <> 0 THEN _
  3291.          LSET ZMsgRec$ = LEFT$(ZMsgRec$,115) + _
  3292.                                 ZActiveMessage$ + _
  3293.                                 MID$(ZMsgRec$,117) : _
  3294.          PUT 1,LOC(1) : _
  3295.          ZWasY$ = "Restored Msg #" + _
  3296.               STR$(MsgToRecover) : _
  3297.          ActionFlag = ZTrue : _
  3298.          GOTO 10485
  3299. 10480 ZWasY$ = "Msg #" + _
  3300.            STR$(MsgToRecover) + _
  3301.            " not Dead"
  3302. 10485 CALL QuickTPut1 (ZWasY$)
  3303.       END SUB
  3304. 10600 ' $SUBTITLE: 'UpdateU -- Update the users record at logoff'
  3305. ' $PAGE
  3306. '  NAME    -- UpdateU
  3307. '
  3308. '  INPUTS  -- PARAMETER             MEANING
  3309. '             ZAdjustedSecurity
  3310. '             ZCurDate$
  3311. '             ZDnlds
  3312. '             ZElapsedTime
  3313. '             ZListDir
  3314. '             ZMainUserFileIndex
  3315. '             ZSecsPerSession!
  3316. '             ZUplds
  3317. '             ZUserSecLevel
  3318. '
  3319. '  OUTPUTS -- ZElapsedTime$
  3320. '             ZListNewDate$
  3321. '             ZSecLevel$
  3322. '             ZUserDnlds$
  3323. '             ZUserUplds$
  3324. '
  3325. '  PURPOSE -- Update the user record for the user when the user
  3326. '             exits RBBS-PC.
  3327. '
  3328.       SUB UpdateU (LoggingOff) STATIC
  3329.       IF ZActiveUserName$ = "" OR ZFirstName$ = "" THEN _
  3330.          EXIT SUB
  3331.       IF ZActiveUserFile$ = ZOrigUserFile$ THEN _
  3332.          ZUplds = ZGlobalUplds : _
  3333.          ZDnlds = ZGlobalDnlds : _
  3334.          ZDLToday! = ZGlobalDLToday! : _
  3335.          ZBytesToday! = ZGlobalBytesToday! : _
  3336.          ZDLBytes! = ZGlobalDLBytes! : _
  3337.          ZULBytes! = ZGlobalULBytes!
  3338.       IF ZUserFileIndex < 1 THEN _
  3339.          GOTO 10607
  3340.       UpdateDefaults = ZTrue
  3341. 10602 ZSubParm = 6
  3342.       CALL FileLock
  3343.       CALL OpenUser (HighestUserRecord)
  3344.       FIELD 5,31 AS ZUserName$, _
  3345.               15 AS ZPswd$, _
  3346.                2 AS ZSecLevel$, _
  3347.               14 AS ZUserOption$,  _
  3348.               24 AS ZCityState$, _
  3349.               3 AS MachineType$, _
  3350.               4 AS ZTodayDl$, _
  3351.               4 AS ZTodayBytes$, _
  3352.               4 AS ZDlBytes$, _
  3353.               4 AS ZULBytes$, _
  3354.               14 AS ZLastDateTimeOn$, _
  3355.                3 AS ZListNewDate$, _
  3356.                2 AS ZUserDnlds$, _
  3357.                2 AS ZUserUplds$, _
  3358.                2 AS ZElapsedTime$
  3359. 10604 GET 5,ZUserFileIndex
  3360.       IF UpdateDefaults THEN _
  3361.          CALL DefaultU
  3362.       IF ZListDir THEN _
  3363.          LSET ZListNewDate$ = CHR$(VAL(MID$(ZCurDate$,7,2))) + _
  3364.                                CHR$(VAL(MID$(ZCurDate$,1,2))) + _
  3365.                                CHR$(VAL(MID$(ZCurDate$,4,2)))
  3366. 10605 LSET ZUserDnlds$ = MKI$(ZDnlds)
  3367.       LSET ZUserUplds$ = MKI$(ZUplds)
  3368.       IF ZEnforceRatios THEN _
  3369.          LSET ZTodayDl$ = MKS$(ZDLToday!) : _
  3370.          LSET ZTodayBytes$ = MKS$(ZBytesToday!) : _
  3371.          LSET ZDlBytes$ = MKS$(ZDLBytes!) : _
  3372.          LSET ZULBytes$ = MKS$(ZULBytes!)
  3373.       CALL CheckTime (ZUserLogonTime!, ZSecsUsedSession!, 2)
  3374.       IF (NOT ZExitToDoors) AND LoggingOff THEN _
  3375.          TempElapsed! = ZElapsedTime + _
  3376.                        (ZSecsUsedSession! - ZTimeCredits!) / 60 : _
  3377.          ZTimeCredits! = 0 _
  3378.       ELSE TempElapsed! = ZElapsedTime
  3379.       IF TempElapsed! < -32767 THEN _
  3380.          TempElapsed! = -32767 _
  3381.       ELSE IF TempElapsed! > 32767 THEN _
  3382.          TempElapsed! = 32767
  3383.       LSET ZElapsedTime$ = MKI$(TempElapsed!)
  3384.       IF ZAdjustedSecurity THEN _
  3385.          LSET ZSecLevel$ = MKI$(ZUserSecLevel)
  3386.       PUT 5,ZUserFileIndex
  3387.       ZSubParm = 8
  3388.       CALL FileLock
  3389.       IF ZActiveUserFile$ <> ZOrigUserFile$ AND LoggingOff THEN _
  3390.          ZActiveUserFile$ = ZOrigUserFile$ : _
  3391.          ZUserFileIndex = ZOrigUserFileIndex : _
  3392.          UpdateDefaults = ZFalse : _
  3393.          GOTO 10602
  3394. 10607 IF ZExitToDoors OR NOT LoggingOff THEN _
  3395.          EXIT SUB
  3396.       Temp = ZMinsPerSession
  3397.       IF ZMaxPerDay > 0 THEN _
  3398.          Temp = ZMaxPerDay - TempElapsed! : _
  3399.          IF Temp > ZMinsPerSession THEN _
  3400.             Temp = ZMinsPerSession
  3401.       Temp = -(Temp > 0) * Temp
  3402.       CALL QuickTPut1 (STR$(Temp)+" min left for next call today")
  3403.       CALL QuickTPut1 (ZFirstName$ + ", Thanks and please call again!")
  3404.       IF NOT ZHiLiteOff THEN _
  3405.          CALL QuickTPut1 (ZColorReset$)
  3406.       CALL DelayTime (8 + ZBPS)
  3407.       END SUB
  3408. 10935 ' $SUBTITLE: 'DosExit -- Setup to exit to DOS for ZSysop'
  3409. ' $PAGE
  3410. '  NAME    -- DosExit
  3411. '
  3412. '  INPUTS  -- PARAMETER             MEANING
  3413. '             ZComPort$
  3414. '             ZDoorsTermType
  3415. '             ZMultiLinkPresent
  3416. '             ZRBBSBat$
  3417. '             ZRedirectIOMethod
  3418. '             ZUseDeviceDriver$
  3419. '
  3420. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3421. '                                      ZRCTTYBat$
  3422. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3423. '
  3424. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "RBBSExit" and
  3425. '             exit to DOS for the remote RBBS-PC sysop
  3426. '
  3427.       SUB DosExit STATIC
  3428.       IF ZMultiLinkPresent AND _
  3429.          ZDoorsTermType > 0 THEN _
  3430.          ZFF = 0 : _
  3431.          GOTO 10950
  3432.       ZOutTxt$(1) = "ECHO OFF"
  3433.       IF ZUseDeviceDriver$ <> "" THEN _
  3434.          Port$ = ZUseDeviceDriver$ _
  3435.       ELSE Port$ = "COM" + RIGHT$(ZComPort$,1)
  3436.       IF ZRedirectIOMethod THEN _
  3437.          ZFF = 5 : _
  3438.          ZOutTxt$(2) = "CTTY " + _
  3439.                  Port$ : _
  3440.          ZOutTxt$(3) = ZDiskForDos$ + _
  3441.                  "COMMAND" : _
  3442.          ZOutTxt$(4) = "CTTY CON" : _
  3443.          ZOutTxt$(5) = ZRBBSBat$ _
  3444.       ELSE ZFF = 3 : _
  3445.            ZOutTxt$(2) = ZDiskForDos$ + _
  3446.                    "COMMAND >" + _
  3447.                    Port$ + _
  3448.                    " <" + _
  3449.                    Port$ : _
  3450.            ZOutTxt$(3) = ZRBBSBat$
  3451. 10950 CALL AMorPM
  3452.       CALL UpdtCalr ("Exited to DOS at " + ZTime$,2)
  3453.       CALL QuickTPut1 ("RBBS-PC " + ZVersionID$)
  3454.       CALL QuickTPut1 ("SYSOP in Remote Console Mode")
  3455.       CALL RBBSExit (ZOutTxt$(),ZFF)
  3456.       END SUB
  3457. 10976 ' $SUBTITLE: 'WordInFile -- Searches a file to find a word'
  3458. ' $PAGE
  3459. '  NAME    -- WordInFile
  3460. '
  3461. '  INPUTS  -- PARAMETER             MEANING
  3462. '             FilName$              FILE TO SEARCH IN
  3463. '             Strng$                STRING TO SEARCH FOR
  3464. '
  3465. '  OUTPUTS -- InFile                WHETHER STRING Found IN FILE
  3466. '
  3467. '  PURPOSE -- Searches for "Strng$" in file "FILNAME$."  Used to
  3468. '             limit doors and questionnaires to those specified
  3469. '             in their menu files.  The "Strng$" is capitalized
  3470. '             but not the lines in the file, so must be exact
  3471. '             case-sensitive match to be found.  The only character
  3472. '             that can immediately proceed or end a name to be
  3473. '             found must be a blank.
  3474. '
  3475.       SUB WordInFile (FilName$,Strng$,InFile) STATIC
  3476.       InFile = ZFalse
  3477.       CALL FindIt (FilName$)
  3478.       IF NOT ZOK THEN _
  3479.          EXIT SUB
  3480.       WasX = 0
  3481.       CALL AllCaps (Strng$)
  3482.       WHILE NOT EOF(2) AND WasX < 1
  3483.          LINE INPUT #2,ZOutTxt$
  3484.          WasY = 1
  3485. 10978    WasX = INSTR(WasY,ZOutTxt$,Strng$)
  3486.          IF WasX < 1 THEN _
  3487.             GOTO 10980
  3488.          WasY = WasX + 1
  3489.          IF WasX > 1 THEN _
  3490.             IF MID$(ZOutTxt$,WasX - 1,1) <> " " THEN _
  3491.                WasX = 0
  3492.          IF WasX > 0 THEN _
  3493.             WasL = LEN(Strng$) : _
  3494.             IF LEN(ZOutTxt$) => (WasX + WasL) THEN _
  3495.                IF MID$(ZOutTxt$,WasX + WasL,1) <> " " THEN _
  3496.                   WasX = 0
  3497.          IF WasX = 0 THEN _
  3498.             GOTO 10978
  3499. 10980 WEND
  3500.       CLOSE 2
  3501.       InFile = (WasX > 0)
  3502.       END SUB
  3503. 10983 ' $SUBTITLE: 'DoorExit -- Setup to exit to a "door"'
  3504. ' $PAGE
  3505. '  NAME    -- DoorExit
  3506. '
  3507. '  INPUTS  -- PARAMETER             MEANING
  3508. '             ZMultiLinkPresent
  3509. '             ZNodeID$
  3510. '             ZRBBSBat$
  3511. '             ZWasZ$
  3512. '
  3513. '  OUTPUTS -- ZWasQ                    NUMBER OF LINES TO WRITE OUT TO
  3514. '                                      ZRCTTYBat$
  3515. '             ZUserIn$()               LINES TO WRITE OUT TO ZRCTTYBat$
  3516. '
  3517. '  PURPOSE -- Set up ZUserIn$() and ZWasQ in order to call "EXITRBBS" and
  3518. '             exit RBBS-PC to invoke another program
  3519. '
  3520.       SUB DoorExit STATIC
  3521.       IF ZWasZ$ = "" OR _
  3522.          ZWasZ$ = "NONE" THEN _
  3523.          EXIT SUB
  3524.       CALL FindIt (ZWasZ$)
  3525.       IF NOT ZOK THEN _
  3526.          GOTO 10986
  3527.       ExitTo$ = LEFT$(ZWasZ$,LEN(ZWasZ$) - 4)
  3528.       ExitMethod$ = ""
  3529.       ZDooredTo$ = ExitTo$
  3530.       CALL FindIt (ZDoorsDef$)
  3531.       IF NOT ZOK THEN _
  3532.          ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  3533.          GOTO 10989
  3534. 10985 CALL ReadParms (ZOutTxt$(),8,1)
  3535.       IF ZErrCode > 0 THEN _
  3536.          ExitTo$ = ExitTo$ + " " + ZNodeID$ : _
  3537.          GOTO 10989
  3538.       IF ExitTo$ <> ZOutTxt$(1) THEN _
  3539.          GOTO 10985
  3540.       CALL CheckInt (ZOutTxt$(2))
  3541.       IF ZErrCode > 0 THEN _
  3542.          ZErrCode = 0 : _
  3543.          GOTO 10985
  3544.       IF ZUserSecLevel < ZTestedIntValue THEN _
  3545.          CALL QuickTPut1 ("Insufficient security for door") : _
  3546.          EXIT SUB
  3547.       WasX$ = LEFT$(ZOutTxt$(5),INSTR(ZOutTxt$(5)+" "," ")-1)
  3548.       CALL FindIt (WasX$)
  3549.       IF NOT ZOK THEN _
  3550.          GOTO 10986
  3551.       ZFileName$ = ZOutTxt$(3)
  3552.       ExitMethod$ = ZOutTxt$(4)
  3553.       ExitTemplate$ = ZOutTxt$(5)
  3554.       ZDoorDisplay$ = ZOutTxt$(7)
  3555.       DoorTime$ = ZOutTxt$(8)
  3556.       CALL AskUsers
  3557.       CALL SmartText (ExitTemplate$,ZFalse,ZFalse)
  3558.       CALL MetaGSR (ExitTemplate$,ZFalse)
  3559.       ExitTo$ = ExitTemplate$
  3560.       GOTO 10989
  3561. 10986 ZOutTxt$ = "Missing door program"
  3562.       CALL UpdtCalr (ZOutTxt$ + " " + ZWasZ$,1)
  3563.       ZSnoop = ZTrue
  3564.       CALL LPrnt (ZOutTxt$,1)
  3565.       EXIT SUB
  3566. 10989 IF ZTransferFunction = 3 THEN _
  3567.          ZWasY$ = "Registration" _
  3568.       ELSE ZWasY$ = ZDooredTo$
  3569.       ZOutTxt$ = ZWasY$ + _
  3570.            " door opened at " + _
  3571.            TIME$ + _
  3572.            " on " + _
  3573.            DATE$
  3574.       ZSubParm = 5
  3575.       CALL TPut
  3576.       CALL UpdtCalr (ZDooredTo$ + " door opened!",2)
  3577.       CLOSE 2
  3578.       OPEN "O",2,"DORINFO" + _
  3579.                  ZNodeFileID$ + _
  3580.                  ".DEF"
  3581.       PRINT #2,ZRBBSName$
  3582.       PRINT #2,ZSysopFirstName$
  3583.       PRINT #2,ZSysopLastName$
  3584.       IF ZLocalUser THEN _
  3585.          PRINT #2,"COM0" _
  3586.       ELSE PRINT #2,ZComPort$
  3587.       ZUserIn$ = MID$(ZBaudParity$,INSTR(ZBaudParity$," B"))
  3588.       PRINT #2,ZTalkToModemAt$;ZUserIn$
  3589.       PRINT #2,ZNetworkType
  3590.       IF ZGlobalSysop THEN _
  3591.          PRINT #2,"SYSOP" : _
  3592.          PRINT #2,"" _
  3593.       ELSE PRINT #2,ZFirstName$ : _
  3594.            PRINT #2,ZLastName$
  3595.       PRINT #2,ZCityState$
  3596.       PRINT #2,ZWasGR
  3597.       PRINT #2,ZUserSecLevel
  3598.       CALL TimeRemain (MinsRemaining)
  3599.       CALL CheckInt (DoorTime$)
  3600.       IF ZErrCode = 0 AND ZTestedIntValue > 0 THEN _
  3601.          IF MinsRemaining > ZTestedIntValue THEN _
  3602.             MinsRemaining = ZTestedIntValue
  3603.       PRINT #2,INT(MinsRemaining)
  3604.       PRINT #2,ZFossil
  3605.       IF ExitMethod$ = "S" THEN _
  3606.          CALL ShellExit (ExitTemplate$) : _
  3607.          ZExitToDoors = ZTrue : _
  3608.          CALL BufFile (ZDoorDisplay$,WasX) : _
  3609.          CALL DoorReturn _
  3610.       ELSE ZOutTxt$(1) = ZDiskForDos$ + _
  3611.                   "COMMAND /C " + _
  3612.                   ExitTo$ : _
  3613.            ZOutTxt$(2) = ZRBBSBat$ : _
  3614.            CALL RBBSExit (ZOutTxt$(),2)
  3615.       END SUB
  3616. 10992 ' $SUBTITLE: 'RBBSExit -- Setup to exit RBBS'
  3617. ' $PAGE
  3618. '  NAME    -- RBBSExit
  3619. '
  3620. '  INPUTS  -- PARAMETER             MEANING
  3621. '             LINE.ARA        Array of lines to write to batch file
  3622. '             NumLines        How many lines in array
  3623. '
  3624. '  OUTPUTS -- ZRCTTYBat$
  3625. '
  3626. '  PURPOSE -- To create a batch file that control can be passed to
  3627. '             and to exit RBBS-PC while still keeping carrier up
  3628. '
  3629.       SUB RBBSExit (LineAra$(1),NumLines) STATIC
  3630.       CLOSE 2
  3631.       IF NumLines = 0 THEN _
  3632.          GOTO 10994
  3633.       OPEN "O",2,ZRCTTYBat$
  3634.       FOR WasI = 1 TO NumLines
  3635.          IF LineAra$(WasI) <> "" THEN _
  3636.             PRINT #2,LineAra$(WasI)
  3637.       NEXT
  3638.       CLOSE 2
  3639. 10994 CLOSE 3
  3640.       ZExitToDoors = ZTrue
  3641.       IF NOT ZFossil THEN _
  3642.          OUT ZModemCntlReg,INP(ZModemCntlReg) OR 1
  3643.       IF NOT ZPrivateDoor THEN _
  3644.          CALL MLInit (2)
  3645. 10996 CALL UpdateU (ZTrue)
  3646.       CALL GetTime
  3647.       CALL SaveProf (1)
  3648.       IF NumLines = 0 THEN _
  3649.          EXIT SUB
  3650.       CALL DelayTime (9 + ZBPS)
  3651.       IF ZFossil THEN _
  3652.          CALL FOSExit(ZComPort)
  3653.       SYSTEM
  3654.       END SUB
  3655. 12000 ' $SUBTITLE: 'SetSection -- Setup section prompts'
  3656. ' $PAGE
  3657. '  NAME    -- SetSection         Doug Azzarito
  3658. '
  3659. '  INPUTS  -- PARAMETER             MEANING
  3660. '             ZMenuIndex      2 = user is in MAIN section
  3661. '                             3 = user is in FILE section
  3662. '                             4 = user is in UTIL section
  3663. '                             6 = user is in LIBR section
  3664. '
  3665. '  OUTPUTS -- ZSection$       4 character section name
  3666. '             ZActiveMenu$    1 character section name
  3667. '             ZSectionPrompt$ Section name (if ZShowSection config)
  3668. '             ZCmdPrompt$     Command input prompt string
  3669. '             ZSectionOpts$   List of options valid in this sect
  3670. '             ZInvalidOpts$   List of options invalid in this sect
  3671. '             ZSubSection     Index into security array for section
  3672. '
  3673. '  PURPOSE -- To build the prompt strings for the current section
  3674. '
  3675.       SUB SetSection STATIC
  3676.       IF ZMenuIndex <> 6 THEN _
  3677.          ZCurDirPath$ = ZDirPath$
  3678.       ON ZMenuIndex GOTO 12001, 12010,12005,12020,12001,12015
  3679. 12001 EXIT SUB
  3680. 12005 LSET ZSection$ = "FILE"
  3681.       ZSectionOpts$ = ZFileOpts$
  3682.       ZInvalidOpts$ = ZInvalidFileOpts$
  3683.       ZSubSection = ZBegFile
  3684.       GOTO 12025
  3685. 12010 LSET ZSection$ = "MAIN"
  3686.       ZSectionOpts$ = ZMainOpts$
  3687.       ZInvalidOpts$ = ZInvalidMainOpts$
  3688.       ZSubSection = ZBegMain
  3689.       GOTO 12025
  3690. 12015 LSET ZSection$ = "LIBR"
  3691.       ZSectionOpts$ = ZLibOpts$
  3692.       ZInvalidOpts$ = ZInvalidLibraryOpts$
  3693.       ZSubSection = ZBegLibrary
  3694.       ZCurDirPath$ = ZLibDirPath$
  3695.       GOTO 12025
  3696. 12020 LSET ZSection$ = "UTIL"
  3697.       ZSectionOpts$ = ZUtilOpts$
  3698.       ZInvalidOpts$ = ZInvalidUtilOpts$
  3699.       ZSubSection = ZBegUtil
  3700. 12025 ZActiveMenu$ = LEFT$(ZSection$,1)
  3701.       LSET ZLastCommand$ = ZActiveMenu$ + " "
  3702.       IF ZShowSection THEN _
  3703.          ZSectionPrompt$ = ZSection$ _
  3704.       ELSE ZSectionPrompt$ = "Your"
  3705.       IF ZCmndsInPrompt=0 THEN _
  3706.           ZSectionOpts$ = ""
  3707.       ZCmdPrompt$ = ZSectionPrompt$ + _
  3708.                         " command" + _
  3709.                         ZSectionOpts$
  3710.       END SUB
  3711. 12878 ' $SUBTITLE: 'UntilRight - asks question until answer okay'
  3712. ' $PAGE
  3713. '
  3714. '  NAME    -- UntilRight
  3715. '
  3716. '  INPUTS  -- PARAMETER             MEANING
  3717. '             Ques$         QUESTION TO BE ASKED THE USER
  3718. '             Ans$          LOCATION TO STORE THE ANSWER
  3719. '             MinLen        MINIMUM LENGTH OF ANSWER
  3720. '             MaxLen        MAX LENGTH OF ANSWER
  3721. '
  3722. '  OUTPUTS -- Ans$          RESPONSE TO THE QUESTION WHICH THE
  3723. '                                      CALLERS SAYS IS CORRECT
  3724. '
  3725. '  PURPOSE -- Subroutine to ask a user a question until the caller
  3726. '             responds that the answer is correct
  3727. '
  3728.       SUB UntilRight (Ques$,Ans$,MinLen,MaxLen) STATIC
  3729. 12880 ZSubParm = 1
  3730.       ZOutTxt$ = Ques$
  3731.       CALL TGet
  3732.       IF ZSubParm = -1 THEN _
  3733.          GOTO 12882
  3734.       IF ZWasQ = 0 THEN _
  3735.          GOTO 12880
  3736.       IF LEN(ZUserIn$(1)) > MaxLen THEN _
  3737.          CALL QuickTPut1 (STR$(MaxLen) + " chars max") : _
  3738.          GOTO 12880_
  3739.       ELSE IF LEN(ZUserIn$(1)) < MinLen THEN _
  3740.               CALL QuickTPut1 (STR$(MinLen) + " chars min") : _
  3741.               GOTO 12880
  3742.       Ans$ = ZUserIn$(1)
  3743.       ZOutTxt$ = ZUserIn$(1) + _
  3744.            ", right ([Y],N)"
  3745.       ZTurboKey = -ZTurboKeyUser
  3746.       ZSubParm = 1
  3747.       CALL TGet
  3748.       IF ZSubParm = -1 THEN _
  3749.          GOTO 12882
  3750.       IF ZNo THEN _
  3751.          GOTO 12880
  3752.       CALL AllCaps (Ans$)
  3753.       EXIT SUB
  3754. 12882 Ans$ = "GUEST"
  3755.       END SUB
  3756. 13660 ' $SUBTITLE: 'LogError - sub to log errors to CALLERS file'
  3757. ' $PAGE
  3758. '
  3759. '  NAME    -- LogError
  3760. '
  3761. '  INPUTS  --     PARAMETER                    MEANING
  3762. '                    ERR           ERROR NUMBER DETECTED BY BASIC
  3763. '                    ERL           Last LINE NUMBER ENCOUNTERED
  3764. '                                  PRIOR TO ENCOUNTERNING ERROR
  3765. '
  3766. '  OUTPUTS -- NONE
  3767. '
  3768. '  PURPOSE -- To set up a string to write to the callers log
  3769. '             indicating the date, time, error, and error line
  3770. '
  3771.       SUB LogError STATIC
  3772.       WasIX = ERR
  3773.       IF ERR < 1 THEN _
  3774.          WasIX = ZErrCode
  3775.       CALL UpdtCalr("+++ Error " + _
  3776.            STR$(WasIX) + _
  3777.            " line " + _
  3778.            STR$(ERL) + _
  3779.            " at " + _
  3780.            TIME$ + _
  3781.            " on " + _
  3782.            DATE$,2)
  3783.       END SUB
  3784. '
  3785. 20096 ' $SUBTITLE: 'CheckRatio - subroutine to print ul/dl ratio'
  3786. ' $PAGE
  3787. '
  3788. '  NAME    -- CheckRatio
  3789. '
  3790. '  INPUTS  --   PARAMETER                    MEANING
  3791. '               TellUser           TELL USER THEIR RATIO
  3792. '               ZDnlds             FILES DOWNLOADED
  3793. '               ZDLBytes!          BYTES DOWNLOADED
  3794. '               ZUplds             FILES UPLOADED
  3795. '               ZULBytes!          BYTES UPLOADED
  3796. '
  3797. '  OUTPUTS --   ZOK                 -1 if okay to download, 0 otherwise
  3798. '
  3799. '  PURPOSE -- To determine whether the users violated
  3800. '             their upload to download restriction
  3801. '
  3802.       SUB CheckRatio (TellUser) STATIC
  3803.       ZOK = ZTrue
  3804.       IF NOT ZEnforceRatios THEN _
  3805.          GOTO 20110
  3806.       IF ZRatioRestrict# <= 0 THEN _
  3807.          GOTO 20110
  3808. '
  3809. ' Detemine method of ratio checking.  Look ahead to amount downloaded
  3810. '
  3811.       IF ZByteMethod = 1 OR ZByteMethod = 3 THEN _
  3812.          Method$ = "Bytes" : _
  3813.          ULWork# = ZULBytes! : _
  3814.          DLWork# = ZDLBytes! + ZNumDnldBytes!
  3815.       IF ZByteMethod = 0 OR ZByteMethod = 2 THEN _
  3816.          Method$ = "Files" : _
  3817.          ULWork# = ZUplds : _
  3818.          DLWork# = ZDnlds + ZDownFiles
  3819.       IF ULWork# < ZInitialCredit# THEN _
  3820.          ULWork# = ZInitialCredit#
  3821.       IF ZByteMethod = 2 THEN _
  3822.          Today# = ZRatioRestrict# - ZDLToday! - ZDownFiles
  3823.       IF ZByteMethod = 3 THEN _
  3824.          Today# = ZRatioRestrict# - ZBytesToday! - ZNumDnldBytes!
  3825. '
  3826.       Ratio# = 0
  3827.       RatioSuffix$ = ":0"
  3828.       IF ULWork# > 0 THEN _
  3829.          Ratio# = (DLWork# / ULWork#) : _
  3830.          RatioSuffix$ = ":1"
  3831.       IF ZByteMethod > 1 THEN _
  3832.          ZOutTxt$ = "Today Downloaded Files: " + STR$(ZDLToday! + ZDownFiles) + _
  3833.               "  Bytes:" + STR$(ZBytesToday! + ZNumDnldBytes!) : _
  3834.          ZSubParm = 5 : _
  3835.          CALL TPut : _
  3836.          CALL SkipLine (1) : _
  3837.          GOTO 20100
  3838.       WasX$ = STR$(Ratio#)
  3839.       X = INSTR(WasX$,".")
  3840.       IF X > 0 THEN _
  3841.          WasX$ = LEFT$(WasX$,X+1)
  3842.       ZOutTxt$ = Method$ + " Downloaded:" + STR$(DLWork#) + _
  3843.               " Uploaded:" + _
  3844.               STR$(ULWork#) + _
  3845.               " Ratio:" + _
  3846.               WasX$ + _
  3847.               RatioSuffix$
  3848.       ZSubParm = 5
  3849.       CALL TPut
  3850. '
  3851. '  CHECK TO SEE IF THE USER HAS VIOLATED THEIR UL/DL RESTRICTION
  3852. '
  3853. 20100 IF NOT (ZRatioRestrict# > 0 AND TellUser) THEN _
  3854.          EXIT SUB
  3855.       IF ZByteMethod <= 1 THEN _
  3856.          GOTO 20105
  3857.       IF Today# < 0 THEN _
  3858.          ZOutTxt$ = "Sorry, Daily download limit of" + _
  3859.               STR$(ZRatioRestrict#) + " " + _
  3860.               Method$ + " Reached" : _
  3861.          ZOK = ZFalse _
  3862.       ELSE ZOutTxt$ = "Download balance remaining:" + _
  3863.                 STR$(Today#) + _
  3864.                 " " + _
  3865.                 Method$ : _
  3866.            ZOK = ZTrue
  3867.       ZSubParm = 5
  3868.       CALL TPut
  3869.       CALL SkipLine(1)
  3870.       EXIT SUB
  3871. '
  3872. 20105 IF Ratio# > ZRatioRestrict# OR ULWork# = 0 THEN _
  3873.          ZOK = ZFalse : _
  3874.          ZOutTxt$ = "Sorry, DL/UL ratio of" + _
  3875.               STR$(ZRatioRestrict#) + _
  3876.               ":1 " + _
  3877.               Method$ + " exceeded" : _
  3878.          ZSubParm = 5 : _
  3879.          CALL TPut : _
  3880.          ZOutTxt$ = "Minimum upload of" + _
  3881.               STR$(INT(((DLWork# - (ULWork# * ZRatioRestrict#)) _
  3882.               / ZRatioRestrict#) + 1)) + _
  3883.               + " " + Method$ + " required to download" _
  3884.       ELSE ZOutTxt$ = "Balance remaining before upload required:" + _
  3885.                 STR$(INT((ULWork# * ZRatioRestrict#)-DLWork#)) + _
  3886.                 " " + Method$
  3887.       ZSubParm = 5
  3888.       CALL TPut
  3889.       CALL SkipLine (1)
  3890. 20110 END SUB
  3891. 20140 ' $SUBTITLE: 'GetArc - sub to get what files to verbose list'
  3892. ' $PAGE
  3893. '
  3894. '  NAME    -- GetArc
  3895. '
  3896. '  INPUTS  --     PARAMETER                    MEANING
  3897. '                 ZWasQ                       NUMBER OF ENTRIES TYPED
  3898. '                 ZUserIn$()                  ENTRIES TYPED
  3899. '
  3900. '  OUTPUTS --
  3901. '
  3902. '  PURPOSE --  Process the V)erbose list command.
  3903. '              Takes what user types and tries to list it.
  3904. '
  3905.       SUB GetArc STATIC
  3906. 20141 IF ZAnsIndex >= ZLastIndex THEN _
  3907.          CALL QuickTPut1 ("Default extension is "+ZDefaultExtension$)
  3908.       ZOutTxt$ = "What compressed file(s)" + ZPressEnterExpert$
  3909.       CALL PopCmdStack
  3910.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3911.          EXIT SUB
  3912. 20142 ZViolation$ = "View ARC"
  3913.       WasX = ZAnsIndex
  3914.       FOR ZAnsIndex = WasX TO ZLastIndex
  3915.          GOSUB 20143
  3916.          IF ZSubParm < 0 THEN _
  3917.             ZAnsIndex = ZLastIndex + 1
  3918.       NEXT
  3919.       IF ZLastIndex > 1 THEN _
  3920.          EXIT SUB _
  3921.       ELSE GOTO 20141
  3922. 20143 ZWasZ$ = ZUserIn$(ZAnsIndex)
  3923.       CALL AllCaps (ZWasZ$)
  3924.       CALL BreakFileName (ZWasZ$,Drive$,Prefix$,Ext$,ZFalse)
  3925.       IF Ext$ = "" THEN _
  3926.          Ext$ = ZDefaultExtension$ : _
  3927.          ZWasZ$ = ZWasZ$ + "." + ZDefaultExtension$
  3928.       ZFileNameHold$ = ZWasZ$
  3929.       ZFileName$ = ZWasZ$
  3930.       CALL BadFile (Prefix$,BadFileNameIndex)
  3931.       ON BadFileNameIndex GOTO 20144,20146,20147
  3932. 20144 CALL BadFile (ZFileName$,BadFileNameIndex)
  3933.       ON BadFileNameIndex GOTO 20145,20146,20147
  3934. 20145 CALL RotorsDir (ZFileName$,ZSubDir$(),ZSubDirCount + (NOT ZSysop),ZTrue)
  3935.       IF ZOK THEN _
  3936.          GOTO 20148
  3937. 20146 ZWasZ$ = ZUserIn$(ZAnsIndex) + _
  3938.            " not found!"
  3939.       CALL UpdtCalr (ZWasZ$,2)
  3940.       ZOutTxt$ = ZWasZ$ + _
  3941.            " Type correct filename" + ZPressEnterExpert$
  3942.       ZSubParm = 1
  3943.       CALL TGet
  3944.       IF ZSubParm = -1 OR ZWasQ = 0 THEN _
  3945.          RETURN
  3946.       ZUserIn$(ZAnsIndex) = ZUserIn$(1)
  3947.       GOTO 20143
  3948. 20147 CALL SecViolation
  3949.       IF ZDenyAccess THEN _
  3950.          EXIT SUB
  3951.       GOTO 20146
  3952. 20148 WasX$ = ZDiskForDos$ + "V" + Ext$ + ".BAT"
  3953.       CALL FindIt (WasX$)
  3954.       IF NOT ZOK THEN _
  3955.          GOTO 20150
  3956.       ZGSRAra$(3) = MID$(RIGHT$(ZComPort$,1)+"0",1-ZLocalUser, 1)
  3957.       CALL ReadDir (2,1)
  3958.       IF EOF(2) THEN _
  3959.          ZWasZ$ = ZOutTxt$ : _
  3960.          ZGSRAra$(1) = ZFileName$ : _
  3961.          ZGSRAra$(2) = ZArcWork$ _
  3962.       ELSE ZWasZ$ = WasX$ + " " + ZFileName$ + _
  3963.                 " " + ZArcWork$ + " " + ZGSRAra$(3)
  3964.       CALL ShellExit (ZWasZ$)
  3965.       CALL BufFile (ZArcWork$,WasX)
  3966.       RETURN
  3967. 20150 WasX = INSTR(".ARC.PAK.ZIP.LZH.","."+Ext$+".")
  3968.       'IF (WasX < 1) OR (WasX = 1 AND NOT ZTurboRBBS) THEN _
  3969.       IF (WasX < 1) THEN _
  3970.          CALL QuickTPut1 ("View for "+Ext$+" not implemented") : _
  3971.          RETURN
  3972.       CALL QuickTPut1 (ZFileNameHold$ + " has these files")
  3973.       CALL ViewArc
  3974.       RETURN
  3975.       END SUB
  3976. 20235 ' $SUBTITLE: 'BadName - subroutine to find bad file names'
  3977. ' $PAGE
  3978. '
  3979. '  NAME    -- BadName
  3980. '
  3981. '  INPUTS  --     PARAMETER                    MEANING
  3982. '               ZActiveMessageFile$
  3983. '               ZActiveUserFile$
  3984. '               ZCallersFile$
  3985. '               ZCmntsFile$
  3986. '               CONFIG.FILEANAME$
  3987. '               ZMainMsgBackup$
  3988. '               ZMainMsgFile$
  3989. '               ZMaxViolations
  3990. '               ZPswdFile$
  3991. '               ZRBBSBat$
  3992. '               ZRCTTYBat$
  3993. '               ZSubDir$()
  3994. '               ZSubDirIndex
  3995. '               ZViolation$
  3996. '               ZViolationsThisSession
  3997. '               ZWasZ$                          NAME OF FILE
  3998. '
  3999. '  OUTPUTS  -- BadFileNameIndex         1 = FILE NAME IS OK
  4000. '                                       2 = SECURITY BREACH TRIED
  4001. '              ZViolationsThisSession     NUMBER OF VIOLATIONS
  4002. '              FileSpec$                   NAME OF FILE
  4003. '
  4004. '  PURPOSE -- To protect RBBS-PC against the use of bad file names
  4005. '             to either crash the system or to breach RBBS-PC's security
  4006. '
  4007.       SUB BadName (BadFileNameIndex) STATIC
  4008. '
  4009. '
  4010. ' *  TEST FOR SYSTEM FILE ATTEMPT
  4011. '
  4012.       BadFileNameIndex = 2
  4013.       ZWasZ$ = ZFileName$
  4014.       CALL BreakFileName (ZFileName$,DR$,Prefix$,Extension$,ZFalse)
  4015.       IF LEN(Extension$) = 3 THEN _
  4016.          IF INSTR("DEF,MNU,OLD,PUI,BAK,",Extension$+",") > 0 THEN _
  4017.             EXIT SUB
  4018.       ZOK = 0
  4019.       CALL FileNameCheck (ZActiveMessageFile$,Prefix$,Extension$)
  4020.       CALL FileNameCheck (ZActiveUserFile$,Prefix$,Extension$)
  4021.       CALL FileNameCheck (ZCallersFile$,Prefix$,Extension$)
  4022.       CALL FileNameCheck (ZCmntsFile$,Prefix$,Extension$)
  4023.       CALL FileNameCheck (ZFileSecFile$,Prefix$,Extension$)
  4024.       CALL FileNameCheck (ZMainMsgBackup$,Prefix$,Extension$)
  4025.       CALL FileNameCheck (ZOrigMsgFile$,Prefix$,Extension$)
  4026.       CALL FileNameCheck (ZOrigUserFile$,Prefix$,Extension$)
  4027.       CALL FileNameCheck (ZPswdFile$,Prefix$,Extension$)
  4028.       CALL FileNameCheck (ZRBBSBat$,Prefix$,Extension$)
  4029.       CALL FileNameCheck (ZRCTTYBat$,Prefix$,Extension$)
  4030.       CALL FileNameCheck (ZConfigFileName$,Prefix$,Extension$)
  4031.       IF ZOK > 0 THEN _
  4032.          EXIT SUB
  4033.       BadFileNameIndex = 1
  4034.       END SUB
  4035. 20240 ' $SUBTITLE: 'FileNameCheck - checks file match except for drive'
  4036. ' $PAGE
  4037. '
  4038. '  NAME    -- FileNameCheck
  4039. '
  4040. '  INPUTS  --     PARAMETER                    MEANING
  4041. '               CheckThis$           Name of file to check
  4042. '               Pref2$               Prefix to match against
  4043. '               Ext2$                Extension to match against
  4044. '
  4045. '  OUTPUTS  -- ZOK                    1 if got match
  4046. '
  4047. '  PURPOSE -- Checks for match on both prefix and extension of a file
  4048. '             name.   Used to catch match on system files not to be
  4049. '             downloaded.
  4050. '
  4051.       SUB FileNameCheck (CheckThis$,Pref2$,Ext2$) STATIC
  4052.       IF ZOK > 0 THEN _
  4053.          EXIT SUB
  4054.       CALL BreakFileName (CheckThis$,DR$,Pref1$,Ext1$,ZFalse)
  4055.       IF Pref1$ = Pref2$ THEN _
  4056.          IF Ext1$ = Ext2$ THEN _
  4057.             ZOK = 1
  4058.       END SUB
  4059.  
  4060.